Inserting Page Breaks with Macro

[rein26]

Hi and thank you for looking,

I'm trying to create a macro to insert page breaks above each Header row (Row 1,7,11 in this ex) and if the data between each header contains more than 3 rows, insert a page break every 3 rows. So, below the macro would place a page break between row 4&5, 6&7, 10&11.

This data is Dynamic and the amount of rows between each header varies from file to file.

I've tried to record the macro and create code with no luck. I know there will most likely be a loop and rely on the



[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Header Text[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Header Text[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Header Text[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[igold]

Yikes,

Use this instead:

Sub InstPgBrk()


    Dim blnk As Range, LastCell As Range
    Dim lRow As Long, i As Long, brkrow As Long
    Dim blkBs As Long, PgBrkNo As Long, E3R As Long
    
    ActiveSheet.ResetAllPageBreaks
    Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _
                SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
                Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column)
    lRow = LastCell.Row
    blkBs = WorksheetFunction.CountBlank(Range("B2:B" & lRow))
    
''''''''''''''''''''''''''''''''''''''''Do Every 3 rows''''''''''''''''''''''''''''''''''
    Set blnk = Range("B2:B" & lRow).Find(What:="", _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
    brkrow = blnk.Row
    
    E3R = 2
oneBlank:
    Do Until E3R >= lRow
        If Range("B" & E3R).Value = "" Then
            E3R = E3R + 1
            GoTo oneBlank
        End If
        If Range("B" & E3R).Value <> "" Then
            If Range("B" & E3R + 1).Value <> "" Then
                If Range("B" & E3R + 2).Value <> "" Then
                    ActiveSheet.HPageBreaks.Add before:=Range("B" & E3R + 3)
                End If
            End If
        End If
        E3R = Range("B" & E3R + 3).Row
    Loop
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''Do Header Rows'''''''''''''''''''''''''''''''''''''
    
    Set blnk = Range("B2:B" & lRow).Find(What:="", _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
    brkrow = blnk.Row


    ActiveSheet.HPageBreaks.Add before:=Cells(brkrow, 2)
    PgBrkNo = PgBrkNo + 1
    
    Do Until PgBrkNo >= blkBs
DblHdr:
        Set blnk = Range("B" & brkrow & ":B" & lRow).Find(What:="", _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
        If blnk Is Nothing Then GoTo LH
        If brkrow + 1 = blnk.Row Then
            brkrow = brkrow + 2
            GoTo DblHdr
        End If
        brkrow = blnk.Row
        ActiveSheet.HPageBreaks.Add before:=Cells(brkrow, 2)
        PgBrkNo = PgBrkNo + 1
    Loop
LH:
   
End Sub

Sorry about the confusion...

igold

 

[rein26]

Thank you. I tried to run it and received this error about 10 lines up from the bottom of the code:


Compile Error: Label not defined

If blnk Is Nothing Then GoTo ThreeRows

 

[igold]

I know, that is why I posted the second copy. Make sure you are using the post # 11.

 

[rein26]

Works perfectly! Thank you!

For fun, this is what I came up with to at least get the pagebreaks above the headers. It works, but an it takes forever to run and get an overflow error...it was fun trying though!

Dim i As Integer
i = 2

Do Until i = Cells(i, 1) = ""
If Cells(i, 2).Value = "" And Cells(i, 1).Value <> "" Then
Cells(i, 1).PageBreak = xlPageBreakManual
End If


i = i + 1

Loop

 

[igold]

Great, I am glad that it works for you.

I find that one of the great things about Excel is that you can do any particular task in multiple ways. I am sure that if you took the time you could create a line in your code that would suppress the overflow error or redirect the code before the error pops.

Thanks for the feedback!

Regards,

igold

 

[rein26]

By studying your code I was able to use some technique/logic and fix my overflow issue (Establishing FinalRow for more efficient, smaller data set). Too bad I can't use this code since your's is way better

Thanks again, you really helped me advance my VBA knowledge!

ActiveSheet.ResetAllPageBreaks
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

Dim i As Integer
i = 2

Do Until i = FinalRow
If Cells(i, 2).Value = "" And Cells(i, 1).Value <> "" Then
Cells(i, 1).PageBreak = xlPageBreakManual
End If

i = i + 1
Loop

 

[igold]

Again, thanks for the feedback. I am completely self taught and learning new stuff everyday. It is one of the reasons why I like this site the best.

It was my pleasure to help you get better at VBA. There are some really great coders on this site and more often than not they want to help others learn. I am a novice compared to a lot of the guys and gals on here.

But I try!!