Number of Pages Doesn't Update in Loop

[The_Macrotect]

Hi all,

I am exporting data to Excel, and I'd like a macro that will resize it to fit on either letter size paper or legal. I've accomplished this by finding out how many rows of data will fit on letter. If the number of rows is greater than that, it will print on legal.

What I'd like for it to do next is fill the page. I tried accomplishing this with a loop that increases the zoom in page setup until the number of pages is 2 and then decreases it again so it fits on 1, but it just keeps zooming in until it can't anymore and I get an error. Here is my code:

**Edit: I'm using Office 2016**

Sub Format_Deco()

Dim x As Integer, lrow As Integer
x = 1

Rows(6).Delete
Rows(5).Delete
Rows(3).Delete
Rows(1).Delete

lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1

Do Until Cells(x, 1).Value = "Total:"
    x = x + 1
   
    If Cells(x, 1).Value = "" Then
        Rows(x).Delete
        lrow = lrow - 1
    End If
   
    If Cells(x, 1).Value = "Subsubtotal:" Then
        Range("A" & x & ":D" & x).ClearContents
    End If
   
    If Cells(x, 1).Value = "Subtotal:" Then
        Rows(x).Delete
        lrow = lrow - 1
    End If
Loop

Rows(x).Delete

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(0.25)
    .BottomMargin = Application.InchesToPoints(0.25)
    .Orientation = xlPortrait
    .Zoom = 140
End With

If lrow < 36 Then
    ActiveSheet.PageSetup.PaperSize = xlPaperLetter
    MsgBox ("Will print on LETTER size paper")
    If ActiveSheet.PageSetup.Pages.Count > 1 Then
        Do Until ActiveSheet.PageSetup.Pages.Count = 1
            ActiveSheet.PageSetup.Zoom = ActiveSheet.PageSetup.Zoom - 1
        Loop
    End If

    Do Until ActiveSheet.PageSetup.Pages.Count = 2
        ActiveSheet.PageSetup.Zoom = ActiveSheet.PageSetup.Zoom + 1
    Loop
   
    ActiveSheet.PageSetup.Zoom = ActiveSheet.PageSetup.Zoom - 1
    Else: ActiveSheet.PageSetup.PaperSize = xlPaperLegal
    MsgBox ("Will print on LEGAL size paper")
End If

End Sub

I appreciate any thoughts or feedback on what's causing this, or a better way to do it


All the best,
Matt

 

[bobsan42]

- The reason for indefinite zooming is that pagescount needs to be refreshed
- once you bring it down to 1 page, why bring it up to 2 to reduce it again to 1
so something like this, maybe:

...
If lrow < 36 Then
    Application.PrintCommunication = False
    ActiveSheet.PageSetup.PaperSize = xlPaperLetter
    Application.PrintCommunication = True
    MsgBox ("Will print on LETTER size paper")
    If ActiveSheet.PageSetup.Pages.Count > 1 Then
        Do Until ActiveSheet.PageSetup.Pages.Count = 1
            Application.PrintCommunication = False
            ActiveSheet.PageSetup.Zoom = ActiveSheet.PageSetup.Zoom - 1
            Application.PrintCommunication = True
        Loop
    Else
        Do Until ActiveSheet.PageSetup.Pages.Count = 2
            Application.PrintCommunication = False
            ActiveSheet.PageSetup.Zoom = ActiveSheet.PageSetup.Zoom + 1
            Application.PrintCommunication = True
        Loop
        Application.PrintCommunication = False
        ActiveSheet.PageSetup.Zoom = ActiveSheet.PageSetup.Zoom - 1
        Application.PrintCommunication = True
    End If
Else
    Application.PrintCommunication = False
    ActiveSheet.PageSetup.PaperSize = xlPaperLegal
    Application.PrintCommunication = True
    MsgBox ("Will print on LEGAL size paper")
End If
...

I am not sure how good it is to use the row count to determine the page size. Not sure it is a reliable marker.

and instead of all the zoo looping can't you just fit to page:

...
If lrow < 36 Then
    MsgBox ("Will print on LETTER size paper")
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    Application.PrintCommunication = True
Else
    MsgBox ("Will print on LEGAL size paper")
    Application.PrintCommunication = False
    ActiveSheet.PageSetup.PaperSize = xlPaperLegal
    Application.PrintCommunication = True
End If
...