locate page breaks within the month listed - VBA

S

SilentRomance

New Member
Joined
Aug 4, 2021
Messages
46
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
This is what I want to do.
I want to locate Page break with in a month and count them.

Assume that there are 5 PB in month of January, 7 in Feb and 10 in March so there are 22 PB.

This is what I did
VBA Code: 
For r = LastRow To StartRow + 1 Step -1
        If Month(Cells(r, "A")) <> Month(Cells(r - 1, "A")) Then
            '========================================================
            
            mn = Month(Cells(r, "A"))
            If mn = 2 Then                          '#February
                pbCnt = ws.HPageBreaks.Count
                pbLoc = 0
                pRprev = 0
                If pbC >= 1 Then
                    For Each pb In ws.HPageBreaks
                        pbLov = pb.Location.Row
                        
                        If pRprev = 0 Then
                            sumToRow = 1
                        Else
                            sumToRow = pRprev
                        End If

                        Cells(str, 2).Value = "Total"
        
                        pRprev = pb.Location.Row
                    Next pb
                End If
          
            End If

What I expected count of Page Break is 7 in that month (Feb) but it gives me all the total of PB (22).

Is there better way to code this guys?
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
When you say "page breaks", if that means the row numbers which are the first rows on each printed page for a given print range in a specified sheet, does this give you the correct result? (No sources mentioned, because I came up with this myself.) (And this is longer than it needs to be because I have a test sub and an append() function (and a test sub for that) so that you can get the output in an array. If you want the output just Debug.Printed or put into a column of a sheet, feel free to modify to shorten.)

VBA Code: 
Option Explicit

Sub Test__List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range()

ReDim listOfFirstRowsOnEachPrintedPage(0 To 0) As Variant
listOfFirstRowsOnEachPrintedPage = List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(ActiveSheet.Name, "A1:G1000")

Dim i As Integer
i = 1
Do While i <= UBound(listOfFirstRowsOnEachPrintedPage)
    Debug.Print listOfFirstRowsOnEachPrintedPage(i) 'Press Ctrl G from this code Window to see the immediate window/the output.
    i = i + 1
Loop

End Sub
Function List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(sheetName As String, printRange As String)

Dim numberOfPrintedPages As Long
Dim currentRow As Long
Dim previousNumberOfPrintedPages As Integer
Sheets(sheetName).Range(printRange).PrintOut , preview:=True 'Do a print preview to "calibrate" things.

Dim previousView As Integer
previousView = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview

With Range(printRange)
    Dim firstRow As Long
    firstRow = .Rows(1).Row

    Dim firstCol As Integer
    firstCol = .Columns(1).Column

    Dim lastRow As Long
    lastRow = .Rows(.Rows.Count).Row

    Dim lastColumn As Integer
    lastColumn = .Columns(.Columns.Count).Column
End With

currentRow = firstRow
previousNumberOfPrintedPages = 1

ReDim pageBreakRowNumbers(0 To 0) As Variant

With Sheets(sheetName)
    Do While currentRow <= lastRow
        .PageSetup.PrintArea = .Range(.Cells(firstRow, firstCol), .Cells(currentRow, lastColumn)).Address
        numberOfPrintedPages = .PageSetup.Pages.Count
        If numberOfPrintedPages > previousNumberOfPrintedPages Then pageBreakRowNumbers = Append(pageBreakRowNumbers, currentRow)
        currentRow = currentRow + 1
        previousNumberOfPrintedPages = numberOfPrintedPages
    Loop
End With

List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range = pageBreakRowNumbers

ActiveWindow.View = previousView

End Function


Sub Test__Append()

ReDim sampleArray(1 To 2) As Variant
sampleArray(1) = "item 1"
sampleArray(2) = "item 2"
sampleArray = Append(sampleArray, "##Address_1 Line 1##")

Dim i As Integer
i = 1
Do While i <= UBound(sampleArray) - LBound(sampleArray) + 1
    MsgBox sampleArray(i)
    i = i + 1
Loop

End Sub
Function Append(arr As Variant, arg As Variant)
'Two possible errors from client subs:
'(1) arr is not of type variant.
'(2) arr is defined as Dim array() as Variant instead of ReDim array(1 to x) as variant.

    Dim lowerBOundOfInputArray As Integer
    lowerBOundOfInputArray = LBound(arr)

    Dim upperBoundOfInputArray As Integer
    upperBoundOfInputArray = UBound(arr)

    ReDim newArray(lowerBOundOfInputArray To upperBoundOfInputArray) As Variant
    newArray = arr
  
    ReDim Preserve newArray(lowerBOundOfInputArray To upperBoundOfInputArray + 1)
    newArray(upperBoundOfInputArray + 1) = arg
  
    Append = newArray

End Function
 
Last edited:
Upvote 0
Here's another (potential) option:
VBA Code: 
Sub DebugPrint_All_PageBreak_Rows_In_PrintRange()
Dim i As Integer

'If we don't select the last cell in the used range, then we won't get all of the page breaks in the print range!
Range("A" & ActiveSheet.UsedRange.Rows.Count).Select

With ActiveSheet
    MsgBox .HPageBreaks.Count 'The number of page breaks.
    '.PageSetup.PrintArea = "A1:G1000" 'set the print area from here (optional)
    For i = 1 To .HPageBreaks.Count
        Debug.Print .HPageBreaks(i).Location.Row 'The location of each break.
    Next
End With

'Perhaps select this cell to bring you back to the top.
Range("A1").Select
End Sub

If it doesn't count correctly, then you can maybe add the print preview line of code from the previous to "re calibrate". But if that doesn't work, maybe the (very slow) method I posted previously well.
 
Upvote 0
cmowla said:
Here's another (potential) option:
VBA Code: 
Sub DebugPrint_All_PageBreak_Rows_In_PrintRange()
Dim i As Integer

'If we don't select the last cell in the used range, then we won't get all of the page breaks in the print range!
Range("A" & ActiveSheet.UsedRange.Rows.Count).Select

With ActiveSheet
    MsgBox .HPageBreaks.Count 'The number of page breaks.
    '.PageSetup.PrintArea = "A1:G1000" 'set the print area from here (optional)
    For i = 1 To .HPageBreaks.Count
        Debug.Print .HPageBreaks(i).Location.Row 'The location of each break.
    Next
End With

'Perhaps select this cell to bring you back to the top.
Range("A1").Select
End Sub

If it doesn't count correctly, then you can maybe add the print preview line of code from the previous to "re calibrate". But if that doesn't work, maybe the (very slow) method I posted previously well.
Click to expand...
I don't want to print it, all I want is to count the breaks in a month so I would know how many page breaks there are.
 
Upvote 0
SilentRomance said:
I don't want to print it, all I want is to count the breaks in a month so I would know how many page breaks there are.
Click to expand...
So does either code give you the correct result?

To see how many page breaks the first algorithm counts, modify the test sub to the following: (The MsgBox will show you the number of them it counted.)

VBA Code: 
Sub Test__List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range()

ReDim listOfFirstRowsOnEachPrintedPage(0 To 0) As Variant
listOfFirstRowsOnEachPrintedPage = List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(ActiveSheet.Name, "A1:G1000")

Dim i As Integer
i = 1
Do While i <= UBound(listOfFirstRowsOnEachPrintedPage)
    Debug.Print listOfFirstRowsOnEachPrintedPage(i) 'Press Ctrl G from this code Window to see the immediate window/the output.
    i = i + 1
Loop

MsgBox UBound(listOfFirstRowsOnEachPrintedPage)

End Sub
 
Last edited:
Upvote 0
cmowla said:
So does either code give you the correct result?

To see how many page breaks the first algorithm counts, modify the test sub to the following: (The MsgBox will show you the number of them it counted.)

VBA Code: 
Sub Test__List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range()

ReDim listOfFirstRowsOnEachPrintedPage(0 To 0) As Variant
listOfFirstRowsOnEachPrintedPage = List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(ActiveSheet.Name, "A1:G1000")

Dim i As Integer
i = 1
Do While i <= UBound(listOfFirstRowsOnEachPrintedPage)
    Debug.Print listOfFirstRowsOnEachPrintedPage(i) 'Press Ctrl G from this code Window to see the immediate window/the output.
    i = i + 1
Loop

MsgBox UBound(listOfFirstRowsOnEachPrintedPage)

End Sub
Click to expand...
from this part "List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range", can I ask what are you referring to sir?
 
Upvote 0
SilentRomance said:
from this part "List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range", can I ask what are you referring to sir?
Click to expand...
Just add this line to the original code:
VBA Code: 
MsgBox UBound(listOfFirstRowsOnEachPrintedPage)

Okay, to make it easy, erase all of my code from your code module and replace it with the following. The click inside the first Sub and run it. Does the number that pops up (after it finishes) equal the total number of breaks?
VBA Code: 
Option Explicit

Sub Test__List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range()

ReDim listOfFirstRowsOnEachPrintedPage(0 To 0) As Variant
listOfFirstRowsOnEachPrintedPage = List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(ActiveSheet.Name, "A1:G1000")

Dim i As Integer
i = 1
Do While i <= UBound(listOfFirstRowsOnEachPrintedPage)
    Debug.Print listOfFirstRowsOnEachPrintedPage(i) 'Press Ctrl G from this code Window to see the immediate window/the output.
    i = i + 1
Loop

MsgBox UBound(listOfFirstRowsOnEachPrintedPage)

End Sub
Function List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(sheetName As String, printRange As String)

Dim numberOfPrintedPages As Long
Dim currentRow As Long
Dim previousNumberOfPrintedPages As Integer
Sheets(sheetName).Range(printRange).PrintOut , preview:=True 'Do a print preview to "calibrate" things.

Dim previousView As Integer
previousView = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview

With Range(printRange)
    Dim firstRow As Long
    firstRow = .Rows(1).Row

    Dim firstCol As Integer
    firstCol = .Columns(1).Column

    Dim lastRow As Long
    lastRow = .Rows(.Rows.Count).Row

    Dim lastColumn As Integer
    lastColumn = .Columns(.Columns.Count).Column
End With

currentRow = firstRow
previousNumberOfPrintedPages = 1

ReDim pageBreakRowNumbers(0 To 0) As Variant

With Sheets(sheetName)
    Do While currentRow <= lastRow
        .PageSetup.PrintArea = .Range(.Cells(firstRow, firstCol), .Cells(currentRow, lastColumn)).Address
        numberOfPrintedPages = .PageSetup.Pages.Count
        If numberOfPrintedPages > previousNumberOfPrintedPages Then pageBreakRowNumbers = Append(pageBreakRowNumbers, currentRow)
        currentRow = currentRow + 1
        previousNumberOfPrintedPages = numberOfPrintedPages
    Loop
End With

List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range = pageBreakRowNumbers

ActiveWindow.View = previousView

End Function


Sub Test__Append()

ReDim sampleArray(1 To 2) As Variant
sampleArray(1) = "item 1"
sampleArray(2) = "item 2"
sampleArray = Append(sampleArray, "##Address_1 Line 1##")

Dim i As Integer
i = 1
Do While i <= UBound(sampleArray) - LBound(sampleArray) + 1
    MsgBox sampleArray(i)
    i = i + 1
Loop

End Sub
Function Append(arr As Variant, arg As Variant)
'Two possible errors from client subs:
'(1) arr is not of type variant.
'(2) arr is defined as Dim array() as Variant instead of ReDim array(1 to x) as variant.

    Dim lowerBOundOfInputArray As Integer
    lowerBOundOfInputArray = LBound(arr)

    Dim upperBoundOfInputArray As Integer
    upperBoundOfInputArray = UBound(arr)

    ReDim newArray(lowerBOundOfInputArray To upperBoundOfInputArray) As Variant
    newArray = arr
 
    ReDim Preserve newArray(lowerBOundOfInputArray To upperBoundOfInputArray + 1)
    newArray(upperBoundOfInputArray + 1) = arg
 
    Append = newArray

End Function

This is the code from my first post.
 
Upvote 0
cmowla said:
Just add this line to the original code:
VBA Code: 
MsgBox UBound(listOfFirstRowsOnEachPrintedPage)

Okay, to make it easy, erase all of my code from your code module and replace it with the following. The click inside the first Sub and run it. Does the number that pops up (after it finishes) equal the total number of breaks?
VBA Code: 
Option Explicit

Sub Test__List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range()

ReDim listOfFirstRowsOnEachPrintedPage(0 To 0) As Variant
listOfFirstRowsOnEachPrintedPage = List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(ActiveSheet.Name, "A1:G1000")

Dim i As Integer
i = 1
Do While i <= UBound(listOfFirstRowsOnEachPrintedPage)
    Debug.Print listOfFirstRowsOnEachPrintedPage(i) 'Press Ctrl G from this code Window to see the immediate window/the output.
    i = i + 1
Loop

MsgBox UBound(listOfFirstRowsOnEachPrintedPage)

End Sub
Function List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range(sheetName As String, printRange As String)

Dim numberOfPrintedPages As Long
Dim currentRow As Long
Dim previousNumberOfPrintedPages As Integer
Sheets(sheetName).Range(printRange).PrintOut , preview:=True 'Do a print preview to "calibrate" things.

Dim previousView As Integer
previousView = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview

With Range(printRange)
    Dim firstRow As Long
    firstRow = .Rows(1).Row

    Dim firstCol As Integer
    firstCol = .Columns(1).Column

    Dim lastRow As Long
    lastRow = .Rows(.Rows.Count).Row

    Dim lastColumn As Integer
    lastColumn = .Columns(.Columns.Count).Column
End With

currentRow = firstRow
previousNumberOfPrintedPages = 1

ReDim pageBreakRowNumbers(0 To 0) As Variant

With Sheets(sheetName)
    Do While currentRow <= lastRow
        .PageSetup.PrintArea = .Range(.Cells(firstRow, firstCol), .Cells(currentRow, lastColumn)).Address
        numberOfPrintedPages = .PageSetup.Pages.Count
        If numberOfPrintedPages > previousNumberOfPrintedPages Then pageBreakRowNumbers = Append(pageBreakRowNumbers, currentRow)
        currentRow = currentRow + 1
        previousNumberOfPrintedPages = numberOfPrintedPages
    Loop
End With

List_Of_FirstRows_On_Each_PrintedPage_Of_This_Sheet_With_This_Print_Range = pageBreakRowNumbers

ActiveWindow.View = previousView

End Function


Sub Test__Append()

ReDim sampleArray(1 To 2) As Variant
sampleArray(1) = "item 1"
sampleArray(2) = "item 2"
sampleArray = Append(sampleArray, "##Address_1 Line 1##")

Dim i As Integer
i = 1
Do While i <= UBound(sampleArray) - LBound(sampleArray) + 1
    MsgBox sampleArray(i)
    i = i + 1
Loop

End Sub
Function Append(arr As Variant, arg As Variant)
'Two possible errors from client subs:
'(1) arr is not of type variant.
'(2) arr is defined as Dim array() as Variant instead of ReDim array(1 to x) as variant.

    Dim lowerBOundOfInputArray As Integer
    lowerBOundOfInputArray = LBound(arr)

    Dim upperBoundOfInputArray As Integer
    upperBoundOfInputArray = UBound(arr)

    ReDim newArray(lowerBOundOfInputArray To upperBoundOfInputArray) As Variant
    newArray = arr
 
    ReDim Preserve newArray(lowerBOundOfInputArray To upperBoundOfInputArray + 1)
    newArray(upperBoundOfInputArray + 1) = arg
 
    Append = newArray

End Function

This is the code from my first post.
Click to expand...
In my sample data, total all of page break is 8 but when I run the code msgbox said 27
 
Upvote 0
Since my counter is counting more, I am guessing that your sheet has rows beneath your print area. (I know you don't want to print it out, but Print Area is a factor that must be considered when counting the number of page breaks.)

So as a next test,
  1. Copy the code from the second post into your code module.
  2. Go to Formulas, Name Manager. See the print range that is on your sheet (whatever it is named).
  3. Get writing down what the print range is (in my case, it's "A1"G30"):
print range.PNG


Then put whatever that print range is in place of "A1:G1000" in the following code (this code is from the second post, but the .PageSetup.PrintArea line is uncommented now). And run that. Does the number is MsgBox to you the correct number now?

VBA Code: 
        Sub DebugPrint_All_PageBreak_Rows_In_PrintRange()
Dim i As Integer

'If we don't select the last cell in the used range, then we won't get all of the page breaks in the print range!
Range("A" & ActiveSheet.UsedRange.Rows.Count).Select

With ActiveSheet
MsgBox .HPageBreaks.Count 'The number of page breaks.
.PageSetup.PrintArea = "A1:G1000" 'set the print area from here (optional)
For i = 1 To .HPageBreaks.Count
Debug.Print .HPageBreaks(i).Location.Row 'The location of each break.
Next
End With

'Perhaps select this cell to bring you back to the top.
Range("A1").Select
End Sub
 
Last edited:
Upvote 0
cmowla said:
Since my counter is counting more, I am guessing that your sheet has rows beneath your print area. (I know you don't want to print it out, but Print Area is a factor that must be considered when counting the number of page breaks.)

So as a next test,
  1. Copy the code from the second post into your code module.
  2. Go to Formulas, Name Manager. See the print range that is on your sheet (whatever it is named).
  3. Get writing down what the print range is (in my case, it's "A1"G30"):
View attachment 48283

Then put whatever that print range is in place of "A1:G1000" in the following code (this code is from the second post, but the .PageSetup.PrintArea line is uncommented now). And run that. Does the number is MsgBox to you the correct number now?

VBA Code: 
        Sub DebugPrint_All_PageBreak_Rows_In_PrintRange()
Dim i As Integer

'If we don't select the last cell in the used range, then we won't get all of the page breaks in the print range!
Range("A" & ActiveSheet.UsedRange.Rows.Count).Select

With ActiveSheet
MsgBox .HPageBreaks.Count 'The number of page breaks.
.PageSetup.PrintArea = "A1:G1000" 'set the print area from here (optional)
For i = 1 To .HPageBreaks.Count
Debug.Print .HPageBreaks(i).Location.Row 'The location of each break.
Next
End With

'Perhaps select this cell to bring you back to the top.
Range("A1").Select
End Sub
Click to expand...
yup, msgbox show me all the total of page break, Thank you!
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Page Breaks and Subscript out of Range
Replies
1
Views
468
Farscape2020
F
F
  • Question
Checking for Page Breaks Multiple Times
Replies
2
Views
428
Shloime
S
D
  • Question
VBA Control Of Page Breaks
Replies
2
Views
976
DannyDont
D
A
  • Solved
Error with working days in a month
Replies
5
Views
256
Anthony47
A
M
  • Question
How to track choices in a workbook from several drop down lists and reflect the running choices throughout the month
Replies
0
Views
52
mellojeff
M

Forum statistics

Threads
1,215,417
Messages
6,124,787
Members
449,188
Latest member
Hoffk036

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