Set print area based on last row with a given value
I have a workbook with multiple sheets. One sheet has lots of data organized
into a standard number of columns but varying number of rows (well call this
sheet DATA). One of the columns is for certain geographical zones. I have
another sheet (well call MENU) that acts as a menu for the DATA sheet so
that when a button is clicked with one of these zone names, a macro fires to
filter the DATA sheet by the column with the zone names and then prints it.
It works okay, but I spend a lot of time each month updating each individual
macro (136 of them) so that the print area only goes down to the last row
with that particular zone name (i.e. to avoid getting multiple blank pages or
in some cases chopping the data off early). I would like to rewrite the
macros so that it automatically adjusts the print area. So for example, if
Im on the MENU page and I click the button for Zone 1, I want the macro to
go to the DATA page, filter column 10 (J) for €śZone 1€ť and set the print area
to include the last row where €śZone 1€ť appears in column J. Ive found
multiple posts regarding print area, but none that fits my unique situation.
I am including a copy of my current macro below€¦
Sheets("DATA").Select
Selection.AutoFilter Field:=10, Criteria1:="Zone 1"
With ActiveSheet.PageSetup
.PrintTitleRows = "$5:$5"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$5:$I$8591"
With ActiveSheet.PageSetup
.LeftHeader = "Zone 1" & Chr(10) & "Company ABC"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 50
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub
|