If Row Is Visible Then Run Code

nitrammada

nitrammada

Board Regular
Joined
Oct 10, 2018
Messages
78
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code: 
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
 
Sort by date Sort by votes
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.)
VBA Code: 
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
 
Last edited:
Upvote 0
cmowla said:
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.)
VBA Code: 
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
Click to expand...
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?

VBA Code: 
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
 
Upvote 0
nitrammada said:
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?
Click to expand...
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.
 
Upvote 0
cmowla said:
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.
Click to expand...
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
BCDEFG
1
2BUILDING A
3DA Cost Plan
4Cost Plan Summary: 02 October 2021
5
6RefH3DescH5DescA-ZSortDESCRIPTION
71/AENABLING WORKS
81/B02 COLUMNS
9108014
101/DGround Level to Level 1 (55800 to 59300)
11108015
121/FC1 - 1200 x 160mm Reinforced Concrete Columns
13108016
141/H40MPa in-situ concrete to column
15108020
161/JC2 - 350mm Diameter Reinforced Circular Columns
17108021
181/L40MPa in-situ concrete to column.
191/M
201/N31 ALTERATIONS AND RENOVATIONS TO EXISTING BUILDINGS
21100007
221/PProvision 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
231/Q
242/AEARLY WORKS
252/B31 ALTERATIONS AND RENOVATIONS TO EXISTING BUILDINGS
262/C200006
272/DBackpropping
282/E200012
292/FBackprop and support to floors
Sheet1
Cell Formulas
RangeFormula
C3C3=pReportType
C4C4=PROPER(pDocumentType)&": "&TEXT(pPrinted,"DD MMMM YYY")
C7:C8,C22:C23,C18:C20,C16,C14,C12,C10C7="1/"&LEFT(ADDRESS(1,ROW()-6,2),1+(ROW()>32))
C24:C29C24="2/"&LEFT(ADDRESS(1,ROW()-23,2),1+(ROW()>49))
 
Upvote 0
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).
VBA Code: 
Function RowHeight(MR As Range) As Double
RowHeight = MR.RowHeight
End Function
Blank - Copy (2).xlsb
BC
1
2BUILDING A
3DA Cost Plan
4Cost Plan Summary: 02 October 2021
5
6Ref
711/A
821/B
931/C
1541/D
1651/E
2261/F
2371/G
2481/H
2591/I
26101/J
33111/K
34121/L
35131/M
36141/N
37151/O
38161/P
39171/Q
40181/R
41191/S
42201/T
43211/U
44221/V
45231/W
46241/X
47251/Y
48261/Z
49272/A
50282/B
51292/C
52302/D
53312/E
54322/F
55332/G
56342/H
57352/I
58362/J
59372/K
60382/L
61392/M
62402/N
63412/O
64422/P
65432/Q
66442/R
67452/S
68462/T
69472/U
70482/V
71492/W
72502/X
73512/Y
74522/Z
75533/A
76543/B
77553/C
78563/D
79573/E
80583/F
81593/G
82603/H
83613/I
84623/J
85633/K
86643/L
87653/M
88663/N
89673/O
90683/P
91693/Q
92703/R
93713/S
94723/T
95733/U
96743/V
97753/W
98763/X
99773/Y
100783/Z
Sheet2
Cell Formulas
RangeFormula
B7:B9,B15:B16,B22:B26,B33:B100B7=IF(RowHeight(C7)>=10,B6+1,B6)
C7:C9,C15:C16,C22:C26,C33:C100C7=INT((-1 + 26 + B7)/26)&"/"&MID(IFERROR(ADDRESS(1,MOD(B7,26)),"$Z"),2,1)
 
Upvote 0
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).
VBA Code: 
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
 
Last edited:
Upvote 0
Hi !​
cmowla said:
And this looks like @Marc L 's style of code,
Click to expand...
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 :​
VBA Code: 
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
 
Upvote 0
This morning my head was so 'heavy' so for simplification this is the revamped version of my Excel basics VBA demonstration revamped :​
VBA Code: 
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
 
Last edited:
Upvote 0
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.
VBA Code: 
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
Marc L said:
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 …​
Click to expand...
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!)
VBA Code: 
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
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

U
  • Solved
Rewrite Code as a Sub to work on Active Sheet
Replies
2
Views
224
Skyybot
Skyybot
A
  • Solved
How use RC formulas when fill three columns
2
Replies
18
Views
442
MARK858
MARK858
M
  • Question Question
Formulas with Inititals with Last Name
Replies
3
Views
159
Fluff
Fluff
T
  • Question Question
Formula to the last row
Replies
4
Views
461
th259
T
S
  • Solved
no need space
Replies
8
Views
232
Kaper
Kaper

Forum statistics

Threads
1,226,864
Messages
6,193,413
Members
453,796
Latest member
rcarvalho

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top