locate page breaks within the month listed - VBA

[SilentRomance]

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

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?

 

[SilentRomance]

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?

        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

I was wondering, how do I apply your code in per month?

this is my sample data

I want to count PB with in a month

Like this:
- MsgBox PB in May is 1
- MsgBox PB in Jun is 3
- MsgBox PB in Jul is 2

 

[cmowla]

yup, msgbox show me all the total of page break, Thank you!

You're welcome!

So just use that sub then, but comment out that .PageSetup.PrintArea line again. Because if you don't specify it there, it should just pick up whatever it is on its own . . . I was trying to make 100% certain that the PrintArea was the problem, that's all.

 

[cmowla]

I was wondering, how do I apply your code in per month?

I want to count PB with in a month

Like this:
- MsgBox PB in May is 1
- MsgBox PB in Jun is 3
- MsgBox PB in Jul is 2

I do not see consistency with how you are counting these. Did you make a mistake and it should be one of the following instead?

There are two possible rules that match the numbers you chose:

[Possibility 1]

• Ignore the breaks (blue lines) below the date. Count the breaks that are above the date instead.
  (This is how you could have possibly said that June was 3 and May was 1. But this would imply that July was 4!)

[Possibility 2]

• Count only the breaks that are in between two dates of the same month. This would imply that:
  • May is 1
  • June is 2
  • Jul is 3

The following code follows Possibility 2 and produces this result:

It's very easy to change "the rule", but the rule needs to be consistent.

Below is the code which produced the above result. If you want me to make video explaining it, let me know. (I added some input features to make it easy. Read carefully the prompts (including the title bar at the top. But basically this is how to use it:

1. Copy the code below into a new module.
2. With the sheet with the column of dates in it in view, run the program. You will get the following. With this opened, you can go select the entire print range. It can be one or more columns. (Pressing Ctrl A may help you to select the print range fast.)
   
   In the example you provided, it should read $A$1:$A$23 in the box when you are finshed selecting. Click OK. And it will bring you to the above window with the results.
   
   
   
   
   
   
3. If you have selected more than one column, however, you will be asked this also:
   
   
   
   
   In this case, if the column with dates is column A, you just type in either a or A and press OK.

And here's another example: In this one, I have 2 different year's dates. So it will tell you:

• How many breaks are in each year
• Give the distribution for each month.
• Will do this for all years in the print range column.
• The only assumption is that the dates are in chronological order and that the dates are formatted as dates (not text).

Here's the code:

• If you don't want the Select Print Range (Press [Esc] to key previous.) prompt, then comment out Line #1. (But you will be at mercy of the Page Break View to set it for you and/or you have to set it beforehand!)
• If you want to have the program go select each cell which is at a page break (for visual/verification purposes), uncomment Line #2.

Sub List_Number_Of_Breaks_in_Months_in_Print_Range_Of_Active_Sheet()

Dim currentPageBreakRowNumber As Long
Dim totalNumberOfBreaksForCurrentYear As Integer
Dim monthBeforeBreak As Long
Dim monthAfterBreak As Long
Dim currentYear As Integer
Dim previousYear As Integer
Dim printRange As String
Dim firstYearInPrintRange As Integer
Dim lastYearInPrintRange As Integer
Dim numberOfYears As Integer
Dim currentMonth As Long
Dim messge As String
Dim columnLetterDatesAreIn As String

Dim previousView As Integer
previousView = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 70
On Error GoTo Exit_Sub
'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

    printRange = ""

    'Prompt the user to select the print range, but give them the option to skip by pressing the [Esc] key or Xing out of dialogue box.
    'Line #1
    printRange = RangeSelectionPrompt("Select Print Range (Press [Esc] to keep previous.)"):
 
    'Get the print range from Excel if the user chose not to input it in.
    If printRange <> "" Then
        .PageSetup.PrintArea = printRange
    Else
        printRange = .PageSetup.PrintArea
    End If


Try_Again:
    'If the number of columns in the print range is more than one,
    If Range(printRange).Columns.Count > 1 Then
        'Ask specifically which column contains the dates.
        columnLetterDatesAreIn = InputBox("Please type in the column letter where the dates are." & vbCrLf & vbCrLf & "(Not case-sentive.)", "Type in [1] to quit this program", "")
    
        'Make sure that a letter or letters is inputted, otherwise prompt the user to try again.
        If Consists_Of_Only_English_Alphabet_Letters(columnLetterDatesAreIn) = False Then
        
            'But if a letter wasn't entered but it was a 1, then QUIT.
            If columnLetterDatesAreIn = "1" Then
                GoTo Exit_Sub
            Else 'Otherwise, go through with trying again.
                GoTo Try_Again
            End If
        End If

        'Make the column letter(s) all uppercase if they are not.
        columnLetterDatesAreIn = UCase(columnLetterDatesAreIn)
    Else
        'Get the column number from the single column that is in the print range.
        columnLetterDatesAreIn = Split(.Range(printRange)(1).Address, "$")(1)
        MsgBox "Print Range: " & printRange
    End If

    'Check to see that the first and last cells in the 'column with the dates' in the print range are dates.
        If IsDate(.Range(printRange)(1).Value) = False Then
            MsgBox "The first cell in the print range is not a date" & vbCrLf & vbCrLf & "Print range: " & printRange
            GoTo Exit_Sub
        End If
        If IsDate(.Range(printRange)(.Range(printRange).Rows.Count, 1)) = False Then
            MsgBox "The last cell in the print range is not a date" & vbCrLf & vbCrLf & "Print range: " & printRange
            GoTo Exit_Sub
        End If

    'A line of code which allows the user to break the program's execution should it take too long (for an ENTIRE column as the print range, for example)
    DoEvents

    'Now do the calculations:
        firstYearInPrintRange = Year(.Range(printRange)(1).Value)
        lastYearInPrintRange = Year(.Range(printRange)(.Range(printRange).Rows.Count, 1))
        numberOfYears = lastYearInPrintRange - firstYearInPrintRange + 1
    
        ReDim years_Months_Breaks(1 To numberOfYears, 1 To 12, 1 To 2) As Integer 'Fill an array with 12 arguments whose value is 0.

        totalNumberOfBreaksForCurrentYear = 1
        previousYear = firstYearInPrintRange

        For i = 1 To .HPageBreaks.Count
            currentPageBreakRowNumber = .HPageBreaks(i).Location.Row  'The location of each break.
            monthBeforeBreak = Month(.Range(columnLetterDatesAreIn & currentPageBreakRowNumber - 1).Value)
            monthAfterBreak = Month(.Range(columnLetterDatesAreIn & currentPageBreakRowNumber).Value)

            'If the break is within a month (the page break row is the same month as the row above it),
            If (monthBeforeBreak = monthAfterBreak) Then
                currentYear = Year(.Range(columnLetterDatesAreIn & currentPageBreakRowNumber).Value)

                'Line #2
                'Range(columnLetterDatesAreIn & currentPageBreakRowNumber).Select: MsgBox Range(columnLetterDatesAreIn & currentPageBreakRowNumber).Value & "  " & monthAfterBreak

                'If we have advanced to a new year, add the total number of page breaks to the array (just put with the first month for simplicity).
                If currentYear > previousYear Then
                    years_Months_Breaks(previousYear - firstYearInPrintRange + 1, 1, 1) = totalNumberOfBreaksForCurrentYear - 1
                    totalNumberOfBreaksForCurrentYear = 1
                End If

                previousYear = currentYear
                totalNumberOfBreaksForCurrentYear = totalNumberOfBreaksForCurrentYear + 1
                years_Months_Breaks(currentYear - firstYearInPrintRange + 1, monthBeforeBreak, 2) = years_Months_Breaks(currentYear - firstYearInPrintRange + 1, monthBeforeBreak, 2) + 1
            End If

        Next
            'If we have advanced to a new year, add the total number of page breaks to the array (just put with the first month for simplicity).
            years_Months_Breaks(previousYear - firstYearInPrintRange + 1, 1, 1) = totalNumberOfBreaksForCurrentYear - 1

'Display the total number of breaks for all months in all years.
'MsgBox "Total number of PBs: " & .HPageBreaks.Count

'Display the frequency of breaks in months.  Do it for every year.
    currentYear = 1
    Do While currentYear <= numberOfYears
        currentMonth = 1
        messge = "Number of PBs in year: " & firstYearInPrintRange + currentYear - 1 & ": " & years_Months_Breaks(currentYear, 1, 1) & vbCrLf & vbCrLf
        Do While currentMonth <= 12
            messge = messge & Month_Name(currentMonth) & ": " & years_Months_Breaks(currentYear, currentMonth, 2) & vbCrLf
            currentMonth = currentMonth + 1
        Loop
        MsgBox messge
        currentYear = currentYear + 1
    Loop

End With

'Perhaps select this cell to bring you back to the top.
Range(columnLetterDatesAreIn & "1").Select

ActiveWindow.View = previousView
Exit Sub
Exit_Sub:
ActiveWindow.View = previousView

End Sub


Sub Test__Month_Name()
MsgBox Month_Name(1)
End Sub
Function Month_Name(monthNumber As Long)

Select Case monthNumber
    Case 1
        Month_Name = "January     "
    Case 2
        Month_Name = "February   "
    Case 3
        Month_Name = "March       "
    Case 4
        Month_Name = "April          "
    Case 5
        Month_Name = "May           "
    Case 6
        Month_Name = "June          "
    Case 7
        Month_Name = "July            "
    Case 8
        Month_Name = "August      "
    Case 9
        Month_Name = "September"
    Case 10
        Month_Name = "October    "
    Case 11
        Month_Name = "November "
    Case 12
        Month_Name = "December "
End Select

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
    Selectedarea = ""
    Exit Function
End If

RangeSelectionPrompt = Selectedarea.Address

End Function

Sub Test__Consists_Of_Only_English_Alphabet_Letters()
MsgBox Consists_Of_Only_English_Alphabet_Letters("A1")
MsgBox Consists_Of_Only_English_Alphabet_Letters("A")
MsgBox Consists_Of_Only_English_Alphabet_Letters("a")
MsgBox Consists_Of_Only_English_Alphabet_Letters("AB")
End Sub
'A regular expression to check whether the current character of focus is a lower or uppercase letter of the English alphabet.
'Source:  https://stackoverflow.com/questions/29633517/how-can-i-check-if-a-string-only-contains-letters
'Counterpart to the built-in "IsNumeric()" function.
Function Consists_Of_Only_English_Alphabet_Letters(strValue As String) As Boolean
    Consists_Of_Only_English_Alphabet_Letters = strValue Like WorksheetFunction.Rept("[a-zA-Z]", Len(strValue))
End Function