VBA Code to Auto Adjust Page Breaks

[Justinian]

Every day, I export data from an external database and paste into Excel. From there, I run a macro cleaning up formatting and removing bad data but the number of pages varies day to day and the page break always causes a few blank pages to print. How do I input code into my extant macro so only pages with data print?

 

[pbornemeier]

If you are working with a single worksheet, define the print area to cover your filled cells

    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$19"

If you are working with multiple worksheets, delete the blank ones and optionally define the print area for each remaining sheet.

Function IsWorksheetBlank(Optional wks As Worksheet) As Boolean
    If wks Is Nothing Then Set wks = ActiveSheet
    If Application.WorksheetFunction.CountBlank(wks.Cells) = _
        Application.WorksheetFunction.Count(wks.Cells) Then
        IsWorksheetBlank = True
    End If
End Function

 

[Justinian]

This code only covers A1:H19 so it is not dynamic.

ActiveSheet.PageSetup.PrintArea = "$A$1:$H$19"​

 

[pbornemeier]

If your data is contiguous with no blank rows or columns use:
ActiveSheet.PageSetup.PrintArea = Activesheet.Range("A1").CurrentRegion

If your cleanup leaves some blank rows or columns, if the data after them should start on a new sheet you can insert a horizontal or vertical page break at the next filled row or column and delete the blank rows/columns before .

 

[Justinian]

My data is contiguous.

I just tried your code and it still prints two pages of blanks.

 

[pbornemeier]

When you execute this code:
Activesheet.Range("A1").CurrentRegion.Select
It will select the current region. If some of the selection has apparently empty rows/columns, then they may contain spaces or other non-visible characters (or characters colored to match the background) which would print as blanks. If so delete/change font color those columns and run that code again.

If there are any shapes (which may be transparent) then Excel will extend the default print area to print them.

This will reset any manually applied page breaks:
ActiveSheet.ResetAllPageBreaks

Use View | PageBreak Preview to see how Excel distributes the data over the worksheets. Manually adjusting page breaks there to eliminate blank sheets may reveal how to code something to do the same.

 

[Justinian]

So where in this code below should i add your new code?

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Dim lr As Long, lc As Long
lc = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
lr = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
With Range(Cells(3, 1), Cells(lr, lc))
.Font.Size = 8
.RowHeight = 61.5
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$2"
.PrintTitleColumns = ""
End With[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Rows("2:2").RowHeight = 20.4
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Size = 8[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Deletes unwanted columns before sorting
Range("B:B,D:D,H:K,N:N,AA:AA,AD:AE").EntireColumn.Delete
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = "$A$1:$U$159"
ActiveWindow.View = xlNormalView[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Sort entire data range by last name based on column G (complete by date)
With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SortFields.Clear
.SortFields.Add Key:=Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A2:U" & Cells(Rows.Count, "E").End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("A2").Select

'Closes Book1
Windows("Book1.xlsx").Activate
ActiveWindow.Close[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif][/FONT]

 

[pbornemeier]

If using
Activesheet.Range("A1").CurrentRegion
in the immediate window
selected your filled cells after the edits then replacing
ActiveSheet.PageSetup.PrintArea = "$A$1:$U$159"
with
ActiveSheet.PageSetup.PrintArea = Activesheet.Range("A1").CurrentRegion
should work.

 

[Justinian]

Odd, that small change made it worse. Before, the report I ran was nine pages with 1.5 pages of blank; with your change, it is now 16 pages with five pages of blank.

 

[pbornemeier]

Manually delete all columns to the right of the last filled column and below the last filled row and try printing again.
Use Editing | Find & Select | Selection Pane to confirm that there are no objects on the worksheet you are printing.
Are blank pages still being printed?