If Row Is Visible Then Run Code

[nitrammada]

Hi Everyone,
I have some code that references each row with a page and row reference in column C starting at row 7, this code works fine. However, I have to filter out some unwanted rows not required for the report, so I make the unwanted row height = 0. Can someone help me to run the code only on the visible rows please. Below is the code that runs perfectly well, I figure I will have to wrap it in an If statement somehow, but I'm not sure about all the Dims and variables etc. Any help would be appreciated.

Sub RunPgNoSheet1()

'Adds page numbers for the Ref column C on Sheet1
   
      Const c = 3, F1 = "=""", F2 = "/""&LEFT(ADDRESS(1,ROW()-", F3 = ",2),1+(ROW()>", F4 = "))"
            r& = 7
      With ActiveSheet
        For L& = 1 To .HPageBreaks.Count
            P& = r
            r& = .HPageBreaks(L).Location.Row
           .Columns(c).Rows(P & ":" & r - 1).Formula = F1 & L & F2 & P - 1 & F3 & P + 25 & F4
        Next
            P = r
            r = .UsedRange.Rows.Count
            If P <= r Then .Columns(c).Rows(P & ":" & r).Formula = F1 & L & F2 & P - 1 & F3 & P + 25 & F4
      End With

End Sub

 

[cmowla]

Even though it is possible to do, it would make this code a lot longer and slower. (And this looks like @Marc L 's style of code, so maybe he can improve on this.)

An alternative is to add a "mark off" column to the left or right of the table (outside of your print range), and then select that entire column (down through the end of the data, not the entire column) and press CTRL T to create an Excel table out of it with filters. Then click on the arrow and uncheck the character (maybe an X) that you used to mark off the rows.) The printer will not print the hidden rows.

But if you really wanted this, regardless (if you wanted the rows #s to be continuous?), please make a copy of your file and test this to see if it does what you want. (I didn't run the code myself.)

Sub RunPgNoSheet1__Only_To_Visible_Rows()

'Adds page numbers for the Ref column C on Sheet1
      Dim i As Long
      Const c = 3, F1 = "=""", F2 = "/""&LEFT(ADDRESS(1,ROW()-", F3 = ",2),1+(ROW()>", F4 = "))"
            r& = 7
      With ActiveSheet
        For l& = 1 To .HPageBreaks.Count
            P& = r
            r& = .HPageBreaks(l).location.row
            i = P
            Do While i <= r - 1
                If Range("A" & i).EntireRow.Hidden = False Then
                    .Columns(c).Rows(i & ":" & i).Formula = F1 & l & F2 & P - 1 & F3 & P + 25 & F4
                End If
                i = i + 1
            Loop
        Next
            P = r
            r = .usedRange.Rows.Count
            If P <= r Then
                i = P
                Do While i <= r
                    If Range("A" & i).EntireRow.Hidden = False Then
                        .Columns(c).Rows(i & ":" & i).Formula = F1 & l & F2 & P - 1 & F3 & P + 25 & F4
                    End If
                    i = i + 1
                Loop
            End If
      End With
End Sub

 

[nitrammada]

Even though it is possible to do, it would make this code a lot longer and slower. (And this looks like @Marc L 's style of code, so maybe he can improve on this.)

An alternative is to add a "mark off" column to the left or right of the table (outside of your print range), and then select that entire column (down through the end of the data, not the entire column) and press CTRL T to create an Excel table out of it with filters. Then click on the arrow and uncheck the character (maybe an X) that you used to mark off the rows.) The printer will not print the hidden rows.

But if you really wanted this, regardless (if you wanted the rows #s to be continuous?), please make a copy of your file and test this to see if it does what you want. (I didn't run the code myself.)

Sub RunPgNoSheet1__Only_To_Visible_Rows()

'Adds page numbers for the Ref column C on Sheet1
      Dim i As Long
      Const c = 3, F1 = "=""", F2 = "/""&LEFT(ADDRESS(1,ROW()-", F3 = ",2),1+(ROW()>", F4 = "))"
            r& = 7
      With ActiveSheet
        For l& = 1 To .HPageBreaks.Count
            P& = r
            r& = .HPageBreaks(l).location.row
            i = P
            Do While i <= r - 1
                If Range("A" & i).EntireRow.Hidden = False Then
                    .Columns(c).Rows(i & ":" & i).Formula = F1 & l & F2 & P - 1 & F3 & P + 25 & F4
                End If
                i = i + 1
            Loop
        Next
            P = r
            r = .usedRange.Rows.Count
            If P <= r Then
                i = P
                Do While i <= r
                    If Range("A" & i).EntireRow.Hidden = False Then
                        .Columns(c).Rows(i & ":" & i).Formula = F1 & l & F2 & P - 1 & F3 & P + 25 & F4
                    End If
                    i = i + 1
                Loop
            End If
      End With
End Sub

Hi Cmowla,
Thank you for your reply. You are right, I was very grateful to Marc L for his code as I am for yours. Your code works however, I should clarify that I have set my unwanted rows to a row height of 0, or less than 10, I have not hidden them. So I amended your code as below in the hope that <<If Range("A" & i).RowHeight > 10 Then >> would accomplish the same thing but it did not. In addition, while your code works, the row lettering is not sequential, eg 1/A, 1/B, 1/C etc, starting at row 7 it returns 1/A, 1/B, 1/D where row 9 is the unwanted row and row 10 is labelled 1/D. Is there a way I could set the condition based on the row height and, for the row lettering to be sequential when it skips a row who's height is less that 10?

Sub RunPgNoSheet1__Only_To_Visible_Rows02()

'Adds page numbers for the Ref column C on Sheet1
      Dim i As Long
      Const c = 3, F1 = "=""", F2 = "/""&LEFT(ADDRESS(1,ROW()-", F3 = ",2),1+(ROW()>", F4 = "))"
            r& = 7
      With ActiveSheet
        For L& = 1 To .HPageBreaks.Count
            P& = r
            r& = .HPageBreaks(L).Location.Row
            i = P
            Do While i <= r - 1
                If Range("A" & i).RowHeight > 10 Then              'EntireRow.Hidden = False Then
                    .Columns(c).Rows(i & ":" & i).Formula = F1 & L & F2 & P - 1 & F3 & P + 25 & F4
                End If
                i = i + 1
            Loop
        Next
            P = r
            r = .UsedRange.Rows.Count
            If P <= r Then
                i = P
                Do While i <= r
                    If Range("A" & i).RowHeight > 10 Then
                        .Columns(c).Rows(i & ":" & i).Formula = F1 & L & F2 & P - 1 & F3 & P + 25 & F4
                    End If
                    i = i + 1
                Loop
            End If
      End With
End Sub

 

[cmowla]

Hi Cmowla,
Thank you for your reply. You are right, I was very grateful to Marc L for his code as I am for yours. Your code works however, I should clarify that I have set my unwanted rows to a row height of 0, or less than 10, I have not hidden them. So I amended your code as below in the hope that <<If Range("A" & i).RowHeight > 10 Then >> would accomplish the same thing but it did not. In addition, while your code works, the row lettering is not sequential, eg 1/A, 1/B, 1/C etc, starting at row 7 it returns 1/A, 1/B, 1/D where row 9 is the unwanted row and row 10 is labelled 1/D. Is there a way I could set the condition based on the row height and, for the row lettering to be sequential when it skips a row who's height is less that 10?

I have no idea, because I don't know what the Worksheet this code is manipulating looks like. Can you point me to the topic or provide a sufficiently sized sample of the sheet? Better yet, maybe Marc will see this and do it. If he doesn't reply in a few days, let me know.

 

[nitrammada]

I have no idea, because I don't know what the Worksheet this code is manipulating looks like. Can you point me to the topic or provide a sufficiently sized sample of the sheet? Better yet, maybe Marc will see this and do it. If he doesn't reply in a few days, let me know.

Hello Cmowla, thanks again for your assistance, does this help?
It is the rows that have the red numbering that I have set to a row height of 0 and the page referencing starts at row 7 in column C. Cell C9 should be blank and then cell C10 should be 1/C, cell C12 should be 1/D, does that make sense. The data in columns D -G is in a pivot table but column C is a standard excel column.

20210930 104SOEMT.01 master - mrexcel.xlsm
	B	C	D	E	F	G
1
2		BUILDING A
3		DA Cost Plan
4		Cost Plan Summary: 02 October 2021
5
6		Ref	H3Desc	H5DescA-Z	Sort	DESCRIPTION
7		1/A	ENABLING WORKS
8		1/B		02 COLUMNS
9					108014
10		1/D				Ground Level to Level 1 (55800 to 59300)
11					108015
12		1/F				C1 - 1200 x 160mm Reinforced Concrete Columns
13					108016
14		1/H				40MPa in-situ concrete to column
15					108020
16		1/J				C2 - 350mm Diameter Reinforced Circular Columns
17					108021
18		1/L				40MPa in-situ concrete to column.
19		1/M
20		1/N		31 ALTERATIONS AND RENOVATIONS TO EXISTING BUILDINGS
21					100007
22		1/P				Provision for the installation, movement and maintenance of Pedestrian Walkway for the duration of the works including any necessary overhead protection, vertical barriers, signage and sundry matalwork - exact scope unknown
23		1/Q
24		2/A	EARLY WORKS
25		2/B		31 ALTERATIONS AND RENOVATIONS TO EXISTING BUILDINGS
26		2/C			200006
27		2/D				Backpropping
28		2/E			200012
29		2/F				Backprop and support to floors
Sheet1

Cell Formulas
Range	Formula
C3	C3	=pReportType
C4	C4	=PROPER(pDocumentType)&": "&TEXT(pPrinted,"DD MMMM YYY")
C7:C8,C22:C23,C18:C20,C16,C14,C12,C10	C7	="1/"&LEFT(ADDRESS(1,ROW()-6,2),1+(ROW()>32))
C24:C29	C24	="2/"&LEFT(ADDRESS(1,ROW()-23,2),1+(ROW()>49))

 

[cmowla]

If all Marc's program was is to write 1/A, etc., in Column C, and you want it to only do so for the visible rows, you just need one helper column (which you can hide) and the user defined function (UDF).

Function RowHeight(MR As Range) As Double
RowHeight = MR.RowHeight
End Function

Blank - Copy (2).xlsb
	B	C
1
2		BUILDING A
3		DA Cost Plan
4		Cost Plan Summary: 02 October 2021
5
6		Ref
7	1	1/A
8	2	1/B
9	3	1/C
15	4	1/D
16	5	1/E
22	6	1/F
23	7	1/G
24	8	1/H
25	9	1/I
26	10	1/J
33	11	1/K
34	12	1/L
35	13	1/M
36	14	1/N
37	15	1/O
38	16	1/P
39	17	1/Q
40	18	1/R
41	19	1/S
42	20	1/T
43	21	1/U
44	22	1/V
45	23	1/W
46	24	1/X
47	25	1/Y
48	26	1/Z
49	27	2/A
50	28	2/B
51	29	2/C
52	30	2/D
53	31	2/E
54	32	2/F
55	33	2/G
56	34	2/H
57	35	2/I
58	36	2/J
59	37	2/K
60	38	2/L
61	39	2/M
62	40	2/N
63	41	2/O
64	42	2/P
65	43	2/Q
66	44	2/R
67	45	2/S
68	46	2/T
69	47	2/U
70	48	2/V
71	49	2/W
72	50	2/X
73	51	2/Y
74	52	2/Z
75	53	3/A
76	54	3/B
77	55	3/C
78	56	3/D
79	57	3/E
80	58	3/F
81	59	3/G
82	60	3/H
83	61	3/I
84	62	3/J
85	63	3/K
86	64	3/L
87	65	3/M
88	66	3/N
89	67	3/O
90	68	3/P
91	69	3/Q
92	70	3/R
93	71	3/S
94	72	3/T
95	73	3/U
96	74	3/V
97	75	3/W
98	76	3/X
99	77	3/Y
100	78	3/Z
Sheet2

Cell Formulas
Range	Formula
B7:B9,B15:B16,B22:B26,B33:B100	B7	=IF(RowHeight(C7)>=10,B6+1,B6)
C7:C9,C15:C16,C22:C26,C33:C100	C7	=INT((-1 + 26 + B7)/26)&"/"&MID(IFERROR(ADDRESS(1,MOD(B7,26)),"$Z"),2,1)

 

[cmowla]

And here is the VBA version (which will delete the helper column's contents afterwards and convert the number/letter fractions to values only (formulas removed).

Sub Fill_In_Number_Letter_Division()
Dim firstCellAddress$, helperColumnLetter$, firstCellLetter$, startRow&, lastRow&
'___________________________________________________________________
'Inputs
firstCellAddress = "C17"
helperColumnLetter = "B"
lastRow = 1000
'___________________________________________________________________

firstCellLetter = Split(Cells(1, Range(firstCellAddress).Column).Address, "$")(1)
startRow = Range(firstCellAddress).Row - 1
Range(helperColumnLetter & startRow + 1 & ":" & helperColumnLetter & lastRow).Formula = "=IF(RowHeight(" & firstCellAddress & ")>=10," & helperColumnLetter & startRow & "+1," & helperColumnLetter & startRow & ")"
With Range(firstCellLetter & startRow + 1 & ":" & firstCellLetter & lastRow)
    .Formula = "=INT((25+" & helperColumnLetter & startRow + 1 & ")/26)&" & """/""" & "&MID(IFERROR(ADDRESS(1,MOD(" & helperColumnLetter & startRow + 1 & ",26))," & """$Z""" & "),2,1)"
    .Formula = .Value
End With
Range(helperColumnLetter & startRow + 1 & ":" & helperColumnLetter & lastRow).Formula = ""
End Sub
Function RowHeight(MR As Range) As Double
RowHeight = MR.RowHeight
End Function

 

[Marc L]

Hi !​

And this looks like @Marc L 's style of code,

I don't know I have some style of code.​

Like some people call me The Doctor, I don't know why, maybe 'cause sometimes I travel in a blue box …​

​

Anyway according to post #5 my Excel basics demonstration revamped with column F as criteria for starters :​

Sub Demo1r()
  Const C = 3, F1 = "=IF(F", F2 = "="""",""", F3 = "/""&LEFT(ADDRESS(1,ROW()-", F4 = ",2),1+(ROW()>", F5 = ")),"""")"
    Dim R&, L&, P&, S$
        R = 7
  With ActiveSheet
    For L = 1 To .HPageBreaks.Count
        P = R
        R = .HPageBreaks(L).Location.Row
        S = "-COUNTA(F$" & P & ":F" & P & ")"
       .Columns(C).Rows(P & ":" & R - 1).Formula = F1 & P & F2 & L & F3 & P - 1 & S & F4 & P + 25 & F5
    Next
        P = R
        R = .UsedRange.Rows.Count
    If P <= R Then
        S = "-COUNTA(F$" & P & ":F" & P & ")"
       .Columns(C).Rows(P & ":" & R).Formula = F1 & P & F2 & L & F3 & P - 1 & S & F4 & P + 25 & F5
    End If
  End With
End Sub

 

[Marc L]

This morning my head was so 'heavy' so for simplification this is the revamped version of my Excel basics VBA demonstration revamped :​

Sub Demo1r2d2()
  Const C = 3, F1 = "=IF(F#="""",""", F2 = "/""&LEFT(ADDRESS(1,ROW()-#+1-COUNTA(F$#:F#),2),1+(ROW()>#+25)),"""")"
    Dim R&, L&, P&
        R = 7
  With ActiveSheet
    For L = 1 To .HPageBreaks.Count
        P = R
        R = .HPageBreaks(L).Location.Row
       .Columns(C).Rows(P & ":" & R - 1).Formula = Replace(F1 & L & F2, "#", P)
    Next
        P = R
        R = .UsedRange.Rows.Count
        If P <= R Then .Columns(C).Rows(P & ":" & R).Formula = Replace(F1 & L & F2, "#", P)
  End With
End Sub

 

[cmowla]

Okay, looking at the result of Marc's code tells me that my above formula was wrong. That we need to keep increasing the column letters until we reach the next (printed) page.

Assuming that at least one cell has some value in the column that you want to insert the 1/A fractions into (or a column to the right of it, the following code will:

• Ask you to select the print range. (If you already selected it before with this code and/or did so with the print menu, just press the [Esc] key to continue . . . keep the previous print range.)
• Insert formulas or values in three helper columns. These helper column letters to be filled will be those which are outside of your used range. For example, if the last column you have ever typed anything into is column K, the first helper column to be filled is column L. (And then the other two will be columns M and N.)
• Clear the entire column where you previously put the #/columnLetter fractions (1/A) starting from the first cell where it needs to be placed (which you . . . at the moment, I can change it if you want . . . manually type into the beginning of the code in place of where I currently have "B7") and ending in the very last used cell in that row. So if you choose to put the 1/A fractions in column B, and your print range goes only to row 1000, but you have data in cell B1001, the content in cell B1001 will also be cleared.
• Fill it.
• Remove @ symbols in that column (that Excel is mysteriously putting in, causing a #Value error!)
• Convert the formulas in that column to values only.
• Clear the contents that was placed into the three helper columns such that the number of used columns (your horizontal scroll scope range) will remain the same.
  • (If you want to see the formulas that this code puts into the helper columns, uncomment Line #1 and Line #2 at the end.

Option Explicit

Sub Place_Fractions_On_Visible_Rows_To_Print()

'Assumes that the 1/A fractions are placed starting at row 2 or greater!!!

Dim printRange As String
Dim totalVisibleRowsToBePrintedSoFar As Integer
Dim firstRowOnNextPrintedPage As Long
Dim numOfVisRowsOnCurrentPrintedPage As Integer
Dim currentPageBreakRowNumber As Long
Dim topCellToPlaceFractions As String
Dim lastUsedColumnNumber As Integer
Dim firstRow As Long
Dim lastRow As Long
Dim lastusedRowInSheet As Long
Dim visibleRowIndicator_ColumnLetter As String
Dim numberOfPrintedRowsPerPage_ColumnLetter As String
Dim letterNumberOnCurrentPrintedPage_ColumnLetter As String
Dim columnToPut_Fractions_ColumnLetter As String

'___________________________________
'Input
topCellToPlaceFractions = "B7"
'___________________________________

firstRow = Range(topCellToPlaceFractions).Row

printRange = RangeSelectionPrompt("Select Print Range (Pres [Esc] to keep previous)")

With ActiveSheet
    If printRange <> "" Then
        .PageSetup.PrintArea = printRange
    Else
        printRange = .PageSetup.PrintArea
    End If

    lastRow = Range(printRange).Rows.Count + firstRow - 1

    'Place the helper columns in the columns to the RIGHT of the right-most used column of the data.
    lastUsedColumnNumber = .UsedRange.Columns.Count + .UsedRange.Column - 1 'The actual right-most column.

    '****************************************************************
    'Fill helper column that identifies rows with a row height >= 10.
    '****************************************************************

        lastUsedColumnNumber = lastUsedColumnNumber + 1 'a new column to the right of that.
        visibleRowIndicator_ColumnLetter = Split(Cells(1, lastUsedColumnNumber).Address, "$")(1)

        '=IF(@RowHeight(A7)>=10,H6+1,H6)
        .Range(visibleRowIndicator_ColumnLetter & firstRow & ":" & visibleRowIndicator_ColumnLetter & lastRow).Formula = _
            "=IF(RowHeight(M7)>=10," & visibleRowIndicator_ColumnLetter & firstRow - 1 & "+1," & visibleRowIndicator_ColumnLetter & firstRow - 1 & ")"


    '*******************************************************************************************************
    'Fill helper column that marks the VISIBLE row that is the last row on the current (to be) printed page.
    '*******************************************************************************************************

        lastUsedColumnNumber = lastUsedColumnNumber + 1 'a new column to the right of that.
        numberOfPrintedRowsPerPage_ColumnLetter = Split(Cells(1, lastUsedColumnNumber).Address, "$")(1)

        totalVisibleRowsToBePrintedSoFar = 0
        For currentPageBreakRowNumber = 1 To .HPageBreaks.Count

            firstRowOnNextPrintedPage = .HPageBreaks(currentPageBreakRowNumber).Location.Row

            numOfVisRowsOnCurrentPrintedPage = Range(visibleRowIndicator_ColumnLetter & firstRowOnNextPrintedPage - 1).Value - totalVisibleRowsToBePrintedSoFar

            .Range(numberOfPrintedRowsPerPage_ColumnLetter & firstRowOnNextPrintedPage - 1).Value = numOfVisRowsOnCurrentPrintedPage

            totalVisibleRowsToBePrintedSoFar = totalVisibleRowsToBePrintedSoFar + numOfVisRowsOnCurrentPrintedPage
        Next

    '*****************************************************************************************
    'Fill helper column that signifies the "increment" of the Column Letters in the fractions.
    '*****************************************************************************************

        lastUsedColumnNumber = lastUsedColumnNumber + 1 'a new column to the right of that.
        letterNumberOnCurrentPrintedPage_ColumnLetter = Split(Cells(1, lastUsedColumnNumber).Address, "$")(1)

        '=IF(I7<>"",J6+1,H7-SUM($I$7:I7))
        .Range(letterNumberOnCurrentPrintedPage_ColumnLetter & firstRow & ":" & letterNumberOnCurrentPrintedPage_ColumnLetter & lastRow).Formula = _
        "=IF(" & numberOfPrintedRowsPerPage_ColumnLetter & firstRow & "<>" & Chr(34) & Chr(34) & _
        "," & letterNumberOnCurrentPrintedPage_ColumnLetter & firstRow - 1 & "+1," & visibleRowIndicator_ColumnLetter _
        & firstRow & "-SUM($" & numberOfPrintedRowsPerPage_ColumnLetter & "$" & firstRow & ":" & numberOfPrintedRowsPerPage_ColumnLetter & firstRow & "))"

    '*********************************************************************
    'Fill the column specified by user with the #/column letter fractions.
    '*********************************************************************

        lastusedRowInSheet = .UsedRange.Rows.Count + .UsedRange.Row - 1

        columnToPut_Fractions_ColumnLetter = Split(Cells(1, Range(topCellToPlaceFractions).Column).Address, "$")(1)

        'Clear previous contents in the column of focus (even beneath the print range if the print range doesn't go all the way to the end).
        .Range(columnToPut_Fractions_ColumnLetter & firstRow & ":" & columnToPut_Fractions_ColumnLetter & lastusedRowInSheet).Formula = ""

        With .Range(columnToPut_Fractions_ColumnLetter & firstRow & ":" & columnToPut_Fractions_ColumnLetter & lastRow)
            .Formula = ""
            '=SUM(IF($I$6:I6<>"",1,0))+1&"/"&SUBSTITUTE(SUBSTITUTE(ADDRESS(1,J7),"$",""),"1","")
            .Formula = _
            "=SUM(IF(" & "$" & numberOfPrintedRowsPerPage_ColumnLetter & "$" & firstRow - 1 & ":" & numberOfPrintedRowsPerPage_ColumnLetter & firstRow - 1 & "<>" _
            & Chr(34) & Chr(34) & ",1,0))+1&" & Chr(34) & "/" & Chr(34) & "&SUBSTITUTE(SUBSTITUTE(ADDRESS(1," & letterNumberOnCurrentPrintedPage_ColumnLetter _
            & firstRow & ")," & Chr(34) & "$" & Chr(34) & "," & Chr(34) & Chr(34) & ")," & Chr(34) & "1" & Chr(34) & "," & Chr(34) & Chr(34) & ")"
            .Replace What:="@", Replacement:="", LookAt:=xlPart, FormulaVersion:=xlReplaceFormula2
            ActiveSheet.Calculate
            .Formula = .Value 'Line #1
        End With

    '***********************************************
    'Clear the formulas in all three helper columns.
    '***********************************************
        .Range(visibleRowIndicator_ColumnLetter & firstRow & ":" & letterNumberOnCurrentPrintedPage_ColumnLetter & lastRow).Value = "" 'Line #2

End With

End Sub


Function RowHeight(MR As Range) As Double
RowHeight = MR.RowHeight
End Function


Sub Test__RangeSelectionPrompt()
MsgBox RangeSelectionPrompt("Choose Cells")
End Sub
Function RangeSelectionPrompt(titleOfRangeSelectionPromptBox As String)
'Code is from http://www.vbaexpress.com/forum/showthread.php?763-Solved-Inputbox-Cell-Range-selection-Nothing-selected-or-Cancel&p=6680&viewfull=1#post6680

Dim Selectedarea As Range
On Error Resume Next
Set Selectedarea = Application.InputBox(prompt:="Left click on the top-left cell and drag to the botSomething-right cell.", _
Title:=titleOfRangeSelectionPromptBox, Default:=Selection.Address, Type:=8)

'If the user clicked on cancel,
If Selectedarea Is Nothing Then Exit Function

RangeSelectionPrompt = Selectedarea.Address

End Function

I don't know I have some style of code.​

Like some people call me The Doctor, I don't know why, maybe 'cause sometimes I travel in a blue box …​

Maybe it's because you can get to the heart of the matter with precision? But I see a few regular contributers on here who prefer to use a single letter to name a variable. I actually remember doing that when I programmed my TI-84 plus graphing calculator.

Anyway, I was actually curious to see what my sub above would look like if I condensed it (I substituted the previously descriptive variable names with single letters and removed helpful comments). If I looked at this code in 6 months, I bet I would know exactly what it does. (Just kidding . . . I don't know how you do it, but you're clearly better at this than I am!)

Sub Demo1r2()
Dim A$, B%, C&, D%, E&, F$, G%, H&, I&, J&, K$, L$, M$, N$, O$, P$
F = "B7"
O = Chr(34)
P = O & O
H = Range(F).Row
A = RangeSelectionPrompt("Select Print Range (Pres [Esc] to keep previous)")
With ActiveSheet
    If A <> "" Then
        .PageSetup.PrintArea = A
    Else
        A = .PageSetup.PrintArea
    End If
    I = Range(A).Rows.Count + H - 1
    G = .UsedRange.Columns.Count + .UsedRange.Column - 1
        G = G + 1
        K = Split(Cells(1, G).Address, "$")(1)
        .Range(K & H & ":" & K & I).Formula = "=IF(RowHeight(A7)>=10," & K & H - 1 & "+1," & K & H - 1 & ")"
        G = G + 1
        L = Split(Cells(1, G).Address, "$")(1)
        B = 0
        For E = 1 To .HPageBreaks.Count
            C = .HPageBreaks(E).Location.Row
            D = Range(K & C - 1).Value - B
            .Range(L & C - 1).Value = D
            B = B + D
        Next
        G = G + 1
        M = Split(Cells(1, G).Address, "$")(1)
        .Range(M & H & ":" & M & I).Formula = "=IF(" & L & H & "<>" & P & "," & M & H - 1 & "+1," & K & H & "-SUM($" & L & "$" & H & ":" & L & H & "))"
        J = .UsedRange.Rows.Count + .UsedRange.Row - 1
        N = Split(Cells(1, Range(F).Column).Address, "$")(1)
        .Range(N & H & ":" & N & J).Formula = ""
        With .Range(N & H & ":" & N & I)
            .Formula = ""
            .Formula = _
            "=SUM(IF(" & "$" & L & "$" & H - 1 & ":" & L & H - 1 & "<>" _
            & P & ",1,0))+1&" & O & "/" & O & "&SUBSTITUTE(SUBSTITUTE(ADDRESS(1," & M _
            & H & ")," & O & "$" & O & "," & P & ")," & O & "1" & O & "," & P & ")"
            .Replace What:="@", Replacement:="", LookAt:=xlPart, FormulaVersion:=xlReplaceFormula2
            ActiveSheet.Calculate
            .Formula = .Value
        End With
        .Range(K & H & ":" & M & I).Value = ""
End With
End Sub