Dynamic print area

N

niall91

New Member
Joined
Jul 21, 2020
Messages
45
Office Version
  1. 2019
Platform
  1. Windows
Hi Guys

Having trouble setting a dynamic print area
trying to make this work
but keep coming up with a type mismatch error

VBA Code: 
Sheets("sheets1").pagesetup.PrintArea = .Range(Cells(1,x),Cells(9, y))
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Presumably x and y are determined dynamically within your code

Try this
VBA Code: 
With Sheets("Sheet1")
    .PageSetup.PrintArea = .Range(.Cells(1, x), .Cells(9, y)).Address
End With
 
Upvote 0
Solution
Yongle said:
Presumably x and y are determined dynamically within your code

Try this
VBA Code: 
With Sheets("Sheet1")
    .PageSetup.PrintArea = .Range(.Cells(1, x), .Cells(9, y)).Address
End With
Click to expand...
Thanks that works great
what do you think about this one
trying to autofill
the error message says "autofill method of range class failed"
VBA Code: 
If pagesetup = 1 Then
                Else
                    Range(Cells(1, pagesetup - 9), Cells(14, pagesetup - 1)).Select
                    With Selection
                    .AutoFill Destination:=.Range(.Cells(1, pagesetup), .Cells(14, pagesetup + 9)).Address, Type:=xlFillDefault
                    End With
            End If
 
Upvote 0
Try this amendment to your code
VBA Code: 
        If pagesetup = 1 Then
        Else
          .Range(Cells(1, pagesetup - 9), .Cells(14, pagesetup - 1)).AutoFill Destination:=.Range(.Cells(1, pagesetup), .Cells(14, pagesetup + 9)).Address, Type:=xlFillDefault
        End If

It would probably be better practice not to use pagesetup as the name of your variable
- it is already used as a VBA worksheet object
docs.microsoft.com

PageSetup object (Excel)

Office VBA reference topic
docs.microsoft.com
 
Upvote 0
This is the sub in a user form

VBA Code: 
Sub okEnter()

    'check that all entry's are correct

    If IsNumeric(Me.Qty.Value) Then
        
        Else
            MsgBox "Enter Numbers Only"
            Me.Qty.Value = ""
            Me.Qty.SetFocus
            Exit Sub
    End If
    If Me.Profile.Value = "" Then
        MsgBox "Please fill in Profile detail"
        Me.Profile.SetFocus
        Exit Sub
    End If
    If Me.Size.Value = "" Then
        MsgBox "Please fill in Size detail"
        Me.Size.SetFocus
        Exit Sub
    End If
    If Me.sWidth.Value = "" Then
        MsgBox "Please fill in Width detail"
        Me.sWidth.SetFocus
        Exit Sub
    End If
    If Me.Timber.Value = "" Then
        MsgBox "Please fill in Timber detail"
        Me.Timber.SetFocus
        Exit Sub
    End If

Set ws = Worksheets("Table")
Set sr = Worksheets("Spice Racks")
Dim X As Long, Y As Long, tlr As Long, tlc As Long, side As Long, setUpPage As Long
Dim tbQty As Byte, tb As Byte, bars As Byte, shelveQty As Byte, shelve As Byte, shelveQty2 As Byte, shelve2 As Byte, shelveQty3 As Byte, shelve3 As Byte
Dim picture As String

tlr = ws.Cells(Rows.Count, 26).End(xlUp).Row
tlc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
     
'Fill size list
     
For X = 1 To tlr
        If ws.Cells(X, 26) = "Compontents" Then
            headerRow = X
'            tlc = ws.Cells(X, Columns.Count).End(xlToLeft).Column
            For Y = X To tlr
                If ws.Cells(Y, 26) = Me.Profile.Value & " " & Me.Size Then
                    side = ws.Cells(Y, 29)
                    tbQty = ws.Cells(Y, 30)
                    tb = ws.Cells(Y, 31)
                    barsQty = ws.Cells(Y, 32)
                    bars = ws.Cells(Y, 33)
                    shelveQty = ws.Cells(Y, 34)
                    shelve = ws.Cells(Y, 35)
                    shelveQty2 = ws.Cells(Y, 36)
                    shelve2 = ws.Cells(Y, 37)
                    shelveQty3 = ws.Cells(Y, 38)
                    shelve3 = ws.Cells(Y, 39)
                    GoTo exitnow
                End If
            Next Y
        End If
    Next X
exitnow:

'loop through range to create pages for printing

For setUpPage = 1 To 10000 Step 9
If Cells(1, setUpPage) = "Customer UI" Then
            
        Else
            
            If setUpPage = 1 Then
                Else
                    .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault
            End If

            Cells(1, setUpPage) = "Customer UI"
            Cells(2, setUpPage) = "Company"
            Cells(3, setUpPage) = "Reference"
            Cells(1, setUpPage + 2) = ws.Cells(1, 3)
            Cells(2, setUpPage + 2) = ws.Cells(2, 3)
            Cells(3, setUpPage + 2) = ws.Cells(3, 3)
            Cells(4, setUpPage) = "Profile"
            Cells(5, setUpPage) = "Timber"
            Cells(4, setUpPage + 2) = Me.Profile.Value
            Cells(5, setUpPage + 2) = Me.Timber.Value
            
            Cells(7, setUpPage + 3) = "QTY"
            Cells(7, setUpPage + 4) = "Height"
            Cells(7, setUpPage + 5) = "Width"
            Cells(8, setUpPage + 3) = Me.Qty.Value
            Cells(8, setUpPage + 4) = Me.Size.Value
            Cells(8, setUpPage + 5) = Me.sWidth.Value
            
            Cells(10, setUpPage + 2) = "Cutting List"
            Cells(11, setUpPage + 2) = "Sides"
            Cells(12, setUpPage + 2) = "T & B Rails"
            Cells(13, setUpPage + 2) = "Cross Bars"
            Cells(14, setUpPage + 2) = "Shelves"
            
            Columns(setUpPage + 2).ColumnWidth = 9.86

            'Fill page number
            
            Cells(48, setUpPage + 7) = "Page"
            On Error GoTo Page1
                pageNum = Cells(48, setUpPage - 1)
                pageNum = pageNum + 1
Page1:
            If pageNum = 0 Then
                pageNum = 1
            End If
            On Error GoTo 0
            
            Cells(39, setUpPage + 8) = pageNum

            'fill cutting list
            'sides
            Cells(11, setUpPage + 3) = (Me.Qty.Value * 2) & " @ "
            Cells(11, setUpPage + 4) = Me.Size.Value & " x " & side + 1
            'top and bottom
            Cells(12, setUpPage + 3) = (tbQty * Me.Qty.Value) & " @ "
            Cells(12, setUpPage + 4) = (Me.sWidth.Value - 30) & " x " & tb + 1
            'bars
            Cells(13, setUpPage + 3) = (barsQty * Me.Qty.Value) & " @ "
            Cells(13, setUpPage + 4) = (Me.sWidth.Value - 30) & " x " & bars + 1
            'shelves
            Cells(14, setUpPage + 3) = (shelveQty * Me.Qty.Value) & " @ "
            Cells(14, setUpPage + 4) = (Me.sWidth.Value - 30) & " x " & shelve + 1
            'shelves2
            If shelevQty2 = "" Then
                Else
                    Cells(15, setUpPage + 3) = (shelveQty2 * Me.Qty.Value) & " @ "
                    Cells(15, setUpPage + 4) = (Me.sWidth.Value - 30) & " x " & shelve2 + 1
            End If
            'shelves3
            If shelevQty3 = "" Then
                Else
                    Cells(16, setUpPage + 3) = (shelveQty3 * Me.Qty.Value) & " @ "
                    Cells(16, setUpPage + 4) = (Me.sWidth.Value - 30) & " x " & shelve3 + 1
            End If
            
            'Place and name  picture
           
            picture = Me.Profile.Value & " " & Me.Size.Value
            ws.Shapes(picture).Copy
            ActiveSheet.Paste
            ActiveSheet.Shapes(picture).Name = picture & " " & pageNum
            picture = picture & " " & pageNum
            ActiveSheet.Shapes(picture).Visible = msoTrue
            ActiveSheet.Shapes(picture).Top = 260
            ActiveSheet.Shapes(picture).Left = Cells(1, setUpPage).Left
            ActiveSheet.Shapes(picture).Width = Cells(1, setUpPage + 9).Left - Cells(1, setUpPage).Left
            
           'set print area 
           
           With Sheets("Spice Racks")
                .pagesetup.PrintArea = .Range(.Cells(1, 1), .Cells(50, setUpPage + 8)).Address
            End With
            
            'Clear User form boxes

            Me.Qty.Value = ""
            Me.Profile.Value = ""
            Me.Size.Value = ""
            Me.sWidth.Value = ""
            Me.Timber.Value = ""
            Exit Sub
End If

Next setUpPage

End Sub
 
Upvote 0
Is this the line which fails?
VBA Code: 
 .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault

VBA requires a sheet reference - amend accordingly
VBA Code: 
With Sheets("XYZ")
     .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault
End With

So if it's Table (ws)
VBA Code: 
With ws
     .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault
End With

or Spice Racks (sr)
VBA Code: 
With sr
     .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault
End With
 
Upvote 0
Yongle said:
Is this the line which fails?
VBA Code: 
 .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault

VBA requires a sheet reference - amend accordingly
VBA Code: 
With Sheets("XYZ")
     .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault
End With

So if it's Table (ws)
VBA Code: 
With ws
     .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault
End With

or Spice Racks (sr)
VBA Code: 
With sr
     .Range(.Cells(1, setUpPage - 9), .Cells(14, setUpPage - 1)).AutoFill Destination:=.Range(.Cells(1, setUpPage), .Cells(14, setUpPage + 9)).Address, Type:=xlFillDefault
End With
Click to expand...

It still wont work
Error message "autofill method of range class failed"
 
Upvote 0
what is the value of variable setUpPage when it fails?

Put on line immediately above problem line
VBA Code: 
MsgBox setUpPage
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
VBA - Print dynamic ranges
Replies
0
Views
115
MooseMoney
M
M
  • Question
Excel to PDF with Bookmarks/Hyperlinks
Replies
3
Views
411
dermie_72
D
S
  • Solved
VBA code - Set Print Area based on last row data
Replies
3
Views
278
Joe4
Joe4
D
  • Question
Very weird print margin problem, need help !
Replies
0
Views
160
dicklim39
D
O
  • Question
Hiding Print area line
Replies
6
Views
255
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,510
Messages
6,125,237
Members
449,217
Latest member
Trystel

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