Macro to insert variable page breaks based on data

[FrenchCelt]

Hello,

I'm working on a macro that formats a report for printing and I have everything done except for one last piece. The page breaks need to be adjusted so that data from a given section doesn't cut off partway through. Is there a way to code for the macro to set for max page size and then adjust the page break upward to right below the nearest row with the word Total in Column A?

 

[MIGHTYJOE028]

I am looking for the same thing. I'd like the worksheet to start with no print area set and then allow the macro to insert page breakers where needed. Unfortunately, it starts out by automatically setting breaks and then my breaks are on top of those.

How can I start with nothing and then define my breaks?

Here is my code...need to add something that starts off blank.

    Dim Name As String
Name = Range("D4")

'Name is the header name that starts each page.
    Range("D1").Select
        Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
    Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(-1, 0).Select
        Worksheets("Print Tab (3 Cases)").Rows(ActiveCell.Row).PageBreak = xlPageBreakManual
    
    Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    
    Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(-1, 0).Select
Worksheets("Print Tab (3 Cases)").Rows(ActiveCell.Row).PageBreak = xlPageBreakManual

 

[MIGHTYJOE028]

This is what worked for me

Dim PageBreak1 As Range
   Dim PageBreak2 As Range
   Dim Name As String
   Name = Range("D4")
    
   With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 3
   End With
   
    Range("D1").Select
    Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
    Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(-1, 0).Select
    
    Set PageBreak1 = ActiveCell.CurrentRegion
        
    Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    
    Cells.Find(What:=Name, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(-1, 0).Select
        
    Set PageBreak2 = ActiveCell.CurrentRegion
    Set ActiveSheet.HPageBreaks(1).Location = PageBreak1
Set ActiveSheet.HPageBreaks(2).Location = PageBreak2