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]

Hi rein26,

What is the Data in Column A between the Header Texts. Or how do you see Excel determining if the cells in Column A, is Data or Header Text?

igold

 

[rein26]

Thank you for following up. Col. A is alphnumeric general text (no specific format) for the entire Col. It's very similar to this and there's actually two header rows (1&2) if that helps, ROW 3 represents the remaining non-header data:

A B
1 1234ABCD-ITEMNUMBER
2 CUSTOMER #
3 1234ABCD


Thank you!

 

[rein26]

USE THIS VERSION:

Thank you for following up. Col. A is alphnumeric general text (no specific format) for the entire Col. It's very similar to this and there's actually two header rows (1&2) if that helps, ROW 3 represents the remaining non-header data:

_____________A
1 1234ABCD-ITEMNUMBER
2 CUSTOMER #
3 1234ABCD

 

[igold]

So the question is, how is Excel going to be able to differentiate between what is Data and what is a Header Text, to know where you want a page break... For instance, if A2 is a Header will cell B2 always be blank.

 

[rein26]

Col. B in the first header row will always be blank, and the page break directly above it.

 

[rein26]

I believe if you select each blank cell in Col. B, insert a pagebreak above and then build a IF condition where your next command as follows: move to next blank cell in col b. and insert page break OR insert page break after 4 rows (whichever comes first).

Note: ignore the 2nd row of header data and just treat it as the non-header data (it's populated exactly the same way).

 

[igold]

When you really break down the logic, the solutions just kind of jump out, don't they?

Not sure if I will do more tonight (US EST: 7:45 PM local), (the Vodka is kicking in), but I will hop on it tomorrow morning.

Perhaps another forum member will pick up tonight.

Cheers,

igold

 

[rein26]

When you really break down the logic, the solutions just kind of jump out, don't they?

Not sure if I will do more tonight (US EST: 7:45 PM local), (the Vodka is kicking in), but I will hop on it tomorrow morning.

Perhaps another forum member will pick up tonight.

Cheers,

igold

Very true. Thanks for your help and no rush! I've learned how to do this efficiently in excel (IF formulas, sort, keyboard shortcuts), so I'm very curious to see it transformed in VBA logic. I tried a good 5 hours to try to figure it out...

 

[igold]

Hi rein26,

See if this comes close to doing what you want. Please test this on a backup copy of your data.

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 ThreeRows
        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
End Sub

Let me know how it goes.

igold