Set Dynamic Print Range

K

km10

New Member
Joined
Sep 1, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
I'm trying to set a print range that varies for each sheet based the last row in column M having data. Right now I have each one set to M175, but some of the pages print out blank and I'd rather it just find the last column that has data and not have to delete pages. It's multiple sheets, but I just included two below. Any ideas on how to write this code?

VBA Code: 
Sub FHWAPrintPDF()
Dim myfhwa As Worksheet
Set myfhwa = ActiveSheet

With ActiveSheet.PageSetup
    .Orientation = xlPortrait
    .LeftMargin = Application.InchesToPoints(0.35)
    .RightMargin = Application.InchesToPoints(0.35)
    .TopMargin = Application.InchesToPoints(0.35)
    .BottomMargin = Application.InchesToPoints(0.5)
    .FitToPagesTall = False
    .FitToPagesWide = 1
    .LeftFooter = "&16 " & Range("B6")
    .CenterFooter = ""
    .RightFooter = "&16 " & Range("F6")
End With

    Sheets("27219").Activate
    ActiveSheet.Range("A1:M57" & "," & "A59:M175").Select
    ActiveSheet.PageSetup.Orientation = xlPortrait
    
    Sheets("27316").Activate
    ActiveSheet.Range("A1:M57" & "," & "A59:M175").Select
    ActiveSheet.PageSetup.Orientation = xlPortrait
    
    Sheets(Array("27219", "27316")).Select
    
    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=ThisWorkbook.Path & "/" & "ACDPW.FHWA.Report." & Format(Date, "DDMMMYYYY"), _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    OpenAfterPublish:=True, _
    IgnorePrintAreas:=False

ThisWorkbook.Sheets("Dashboard").Activate

End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
I admit that Access is my strong point, not Excel, but I'd suggest a dynamic named range using the Offset function. I used several in a chart workbook and that allowed my automation code to deal with ever fluctuating ranges. One formula is this :=OFFSET(DATA!$B$6,0,0,COUNTA(DATA!$B:$B),1)
I'll leave it to you to figure out what some of that means because as I hinted, I no longer remember!
 
Upvote 0
See if this helps. This will set the print range for every sheet.
VBA Code: 
Sub SetPrintAreasEachSheet()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim strAddr As String
    Dim lastRow As Long
    
    Set wb = ThisWorkbook
    
    For Each sht In wb.Worksheets
        
        With sht
            lastRow = .Cells(Rows.Count, "M").End(xlUp).Row
            strAddr = "='" & .Name & "'!" & .Range(.Cells(1, "A"), .Cells(lastRow, "M")).Address
            
            .Names.Add Name:="Print_Area", RefersTo:=strAddr
        End With
    Next sht

End Sub
 
Upvote 0
Alex Blakenburg said:
See if this helps. This will set the print range for every sheet.
VBA Code: 
Sub SetPrintAreasEachSheet()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim strAddr As String
    Dim lastRow As Long
   
    Set wb = ThisWorkbook
   
    For Each sht In wb.Worksheets
       
        With sht
            lastRow = .Cells(Rows.Count, "M").End(xlUp).Row
            strAddr = "='" & .Name & "'!" & .Range(.Cells(1, "A"), .Cells(lastRow, "M")).Address
           
            .Names.Add Name:="Print_Area", RefersTo:=strAddr
        End With
    Next sht

End Sub
Click to expand...
Hi Alex,
That code didn't work, plus it cycles through all the sheets when I just want it to cycle through specific ones. My first range is always set as A1:M57 then the second range varies on each sheet A59:M?. There's a total of 45+ sheets in the file, but I'm only trying to export to pdf specific ones.
 
Upvote 0
km10 said:
There's a total of 45+ sheets in the file, but I'm only trying to export to pdf specific ones.
Click to expand...
OK I have made the change for the range but how is the macro going to know which spreadsheets to include ?
Do you have a list somewhere or a sheet naming convention that it can use ?
 
Upvote 0
Alex Blakenburg said:
OK I have made the change for the range but how is the macro going to know which spreadsheets to include ?
Do you have a list somewhere or a sheet naming convention that it can use ?
Click to expand...
To simplify, I had just include two sheets in my first post. Sheets "27219" and "27316". Full list is "27219", "27316", "28426", "76388", "93371", "93394", "93915", "93917", "93419", "93922"
 
Upvote 0
Try this.
You will need to put the actual print page setup commands inside the "For i = " loop except for the print area setting which the code is already doing.

PS: Seems a lot of columns for Portrait mode.

VBA Code: 
Sub SetPrintAreasEachSheet()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim rngPrn As Range
    Dim strAddr As String
    Dim lastRow As Long
    Dim arrPDFSheets() As Variant
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    Set wb = ThisWorkbook
    arrPDFSheets = Array("27219", "27316", "28426", "76388", "93371", "93394", "93915", "93917", "93419", "93922")
    
    'For sht in wb.worksheets(Array("27219", "27316", "28426", "76388", "93371", "93394", "93915", "93917", "93419", "93922"))
    For i = LBound(arrPDFSheets) To UBound(arrPDFSheets)
        Set sht = wb.Worksheets(arrPDFSheets(i))
        
        With sht
            lastRow = .Cells(Rows.Count, "M").End(xlUp).Row
            
            Set rngPrn = Union(.Range(.Cells(1, "A"), .Cells(57, "M")), _
                                    .Range(.Cells(59, "A"), .Cells(lastRow, "M")))
            strAddr = "='" & .Name & "'!" & rngPrn.Address
            
            .Names.Add Name:="Print_Area", RefersTo:=strAddr
        End With
    Next i
    
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Alex Blakenburg said:
Try this.
You will need to put the actual print page setup commands inside the "For i = " loop except for the print area setting which the code is already doing.

PS: Seems a lot of columns for Portrait mode.

VBA Code: 
Sub SetPrintAreasEachSheet()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim rngPrn As Range
    Dim strAddr As String
    Dim lastRow As Long
    Dim arrPDFSheets() As Variant
    Dim i As Long
   
    Application.ScreenUpdating = False
   
    Set wb = ThisWorkbook
    arrPDFSheets = Array("27219", "27316", "28426", "76388", "93371", "93394", "93915", "93917", "93419", "93922")
   
    'For sht in wb.worksheets(Array("27219", "27316", "28426", "76388", "93371", "93394", "93915", "93917", "93419", "93922"))
    For i = LBound(arrPDFSheets) To UBound(arrPDFSheets)
        Set sht = wb.Worksheets(arrPDFSheets(i))
       
        With sht
            lastRow = .Cells(Rows.Count, "M").End(xlUp).Row
           
            Set rngPrn = Union(.Range(.Cells(1, "A"), .Cells(57, "M")), _
                                    .Range(.Cells(59, "A"), .Cells(lastRow, "M")))
            strAddr = "='" & .Name & "'!" & rngPrn.Address
           
            .Names.Add Name:="Print_Area", RefersTo:=strAddr
        End With
    Next i
   
    Application.ScreenUpdating = True

End Sub
Click to expand...
What would the code be for the export to PDF be? It's the only area where I'm getting an error. I added in the pagesetup within the i loop. Thank you for your help!

VBA Code: 
Sub SetPrintAreasEachSheet()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim rngPrn As Range
    Dim strAddr As String
    Dim lastRow As Long
    Dim arrPDFSheets() As Variant
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    Set wb = ThisWorkbook
    arrPDFSheets = Array("27219", "27316", "28426", "76388", "93371", "93394", "93915", "93917", "93419", "93922")
    
    'For sht in wb.worksheets(Array("27219", "27316", "28426", "76388", "93371", "93394", "93915", "93917", "93419", "93922"))
    For i = LBound(arrPDFSheets) To UBound(arrPDFSheets)
        Set sht = wb.Worksheets(arrPDFSheets(i))
        
        With sht
            lastRow = .Cells(Rows.Count, "M").End(xlUp).Row
            
            Set rngPrn = Union(.Range(.Cells(1, "A"), .Cells(57, "M")), _
                                    .Range(.Cells(59, "A"), .Cells(lastRow, "M")))
            strAddr = "='" & .Name & "'!" & rngPrn.Address
            
            .Names.Add Name:="Print_Area", RefersTo:=strAddr
        End With
    
        With ActiveSheet.PageSetup
           .Orientation = xlPortrait
           .LeftMargin = Application.InchesToPoints(0.35)
           .RightMargin = Application.InchesToPoints(0.35)
           .TopMargin = Application.InchesToPoints(0.35)
           .BottomMargin = Application.InchesToPoints(0.5)
           .FitToPagesTall = False
           .FitToPagesWide = 1
           .LeftFooter = "&16 " & Range("B6")
           .CenterFooter = ""
           .RightFooter = "&16 " & Range("F6")
       End With
    
    Next i
    
    Application.ScreenUpdating = True
    
        
    rngPrn.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=ThisWorkbook.Path & "/" & "ACDPW.FHWA.Report." & Format(Date, "DDMMMYYYY"), _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    OpenAfterPublish:=True, _
    IgnorePrintAreas:=True

ThisWorkbook.Sheets("Dashboard").Activate

End Sub
 
Upvote 0
I am in Australia and have logged off, I will have a look tomorrow.
Do you want it all in the one pdf ?

PS: activesheet needs to be replaced with sht
 
Upvote 0
You must log in or register to reply here.

Similar threads

imback2nite
  • Question Question
Print size change using VBA.
Replies
4
Views
322
imback2nite
imback2nite
K
  • Question Question
80mm Thermal Printer (PSO-80) affects me PDF range
Replies
0
Views
54
kapela2017
K
A
  • Question Question
VBA for setting up the printing pages per sheet
Replies
0
Views
494
Aurum1
A
S
  • Question Question
Excel macros extremely slow
Replies
4
Views
417
Shloime
S
G
  • Solved
Still no solution after 1 Year - Please Help
2
Replies
10
Views
781
jolivanes
jolivanes

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top