VBA - How to insert PageBreak every given range of row until the end of a month listed

[SilentRomance]

Hi guys,

I am trying to insert a pagebreak every given range of rows (Ex. Every 2 rows) until the end of the day of a month listed (Ex. Jan 3 - Jan 31).
And if there is an another month listed (Ex. Feb 1 - 26), it will start counting from the first day of that month and insert pagebreak until the last day of that month.

Check this image.

Thanks in Advance!

 

[bobsan42]

try this:

Option Explicit

Sub AddHorPB(Optional sh As Worksheet)
    If sh Is Nothing Then Set sh = ThisWorkbook.ActiveSheet
    
    'sh.ResetAllPageBreaks '# Uncomment this line to reset ALL pagebreaks in the sheet 
    
    Const rGroup = 2 '# Change the number 2 to whatever number to change the groups size
    
    Dim mm As Long, n As Long, i As Long, j As Long
    Dim cc As Range, rng As Range
    Set rng = sh.Range("A1:" & sh.Range("A1").End(xlDown).Address(0, 0)) '# The sub will process all cells in col A until the first blank cell
    With rng
        For i = 1 To .Cells.Count
            Set cc = .Cells(i, 1)
            n = Month(cc.Value) '# No check if the value is DATE is implemented
            If n <> mm Then
                mm = n
                If cc.Row > 1 Then sh.HPageBreaks.Add cc
                j = 1
            Else
                j = j + 1
                If j > rGroup Then
                    sh.HPageBreaks.Add cc
                    j = 1
                End If
            End If
        Next i
    End With
    
    sh.HPageBreaks.Add cc.Offset(1) '# This adds a HorPagebreak after the last cell
    
    Set cc = Nothing
    Set rng = Nothing
    
End Sub

 

[SilentRomance]

thanks bro

 

[SilentRomance]

Hi bobsan32,
Your code is completely working in my record but when i used it in another record, there is an error when I apply your code...

VBA gave me this "Type mismatch"
n = Month(cc.Value) '# No check if the value is DATE is implemented (in this part)

Because I used your code in the another sheet (2) that is linked from another sheet (1) so the last cell is blank
( =IF(INDEX('Sheet1'!A:A,920,1)=FALSE, "",INDEX('Sheet1'!A:A,920,1)) this code is in the sheet2

how can i fix this?

 

[bobsan42]

The code doesn't know what to do with a cell that cannot represent a date.
If it is only the last cell you can add at the beginning of the sub:

on error resume next

Just keep in mind it's designed for dates.