VBA to create print range to column on right

[Shadkng]

Hi, I would like to VBA create a print range as such: From cell A3 down to a row number specified in cell A1, and then to the rightmost column that has data in it. However there will be hidden columns between column A and the last column. Thanks

 

[jolivanes]

Try

Sub Maybe()
Dim lc As Long, GT As Long
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
GT = Cells(1, 1).Value
    ActiveSheet.PageSetup.PrintArea = Range("A3:A" & GT).Resize(, lc).Address
ActiveSheet.PrintPreview    '<---- Change to print when you're happy.
End Sub

 

[Shadkng]

Hi, this seems to work great. I had some previous code that I want to combine with yours but I am unable to get it to work. Below is what I'm trying to make work if can correct. Thanks so much.

Sub PRINT_RANGE_AUTO()
   Dim lc As Long, GT As Long
  lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
  GT = Cells(1, 1).Value
 ActiveSheet.PageSetup.PrintArea = Range("A3:A" & GT).Resize(, lc).Address           
             
             With ActiveSheet
            .PageSetup.PrintArea = PrintAreaString
            .PageSetup.Orientation = xlLandscape
            .PageSetup.Zoom = False
             If Range("A1") <= 45 Then
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = 1
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 72
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
            Else
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = False
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 72
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
             ActiveSheet.UsedRange.Font.Size = 12
            .UsedRange.RowHeight = 22.75
        End If
        End With
End Sub

 

[Shadkng]

Hi, one more thing before you modify the code. I need to run this same code for several named sheets so is it possible to make a loop to do that? If you could give me an example for two sheets than I can add the others. Otherwise I was going to make 4 separate macros and call them all in another, but that doesn't seem efficient. Thanks

 

[jolivanes]

Which values need changes when the value in A1 <= 45?
What are these values in the A1 Value > 45?
I see that you set the Row Height. Is that the only change? If so, what is the regular Row Height?

I'm going to be busy for the next few days so I don't know when I have time. I'll look at it later.
Maybe someone else in the meantime has some time.

 

[Shadkng]

I have an If statement in the code that when the number of rows is less than the value in A1 it fits all to one sheet, otherwise it fits columns to one sheet. The row height changes when it prints. I actually got the above code, your and mine, to work. So I just want it to run several times in a row for different sheets. It can run the same exact way for all sheets.

 

[jolivanes]

Found a few minutes.

Dim shArr, i As Long    '<----- Add to your Dim Statements
shArr = Array("Sheet4", "Sheet7", "Sheet12", "Sheet65")    '<---- Sheets that the macro should work on. Change to your requirements
For i = Lbound(shArr) To Ubound(shArr)
With Sheets(shArr(i))

    'Your code here

End With
Next i
End Sub

 

[Shadkng]

Hi, I am not sure where to insert your code. Here is what I have...it runs but only formats the first sheet "MASTER FORM" correctly. For the other sheets it doesn't seem to find the right column as the end of the range.

Sub PRINT_RANGE_AUTO_PREVIEW2()
 Dim lc As Long, GT As Long
 Dim shArr, i As Long
 lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
 GT = Cells(1, 1).Value
 
            shArr = Array("MASTER FORM", "PACK SLIP", "INVOICE")    '<---- Sheets that the macro should work on. Change to your requirements
            For i = LBound(shArr) To UBound(shArr)
            With Sheets(shArr(i))
            
            .PageSetup.PrintArea = Range("A3:A" & GT).Resize(, lc).Address
            .PageSetup.Orientation = xlLandscape
            .PageSetup.Zoom = False
             If Range("A1") <= 45 Then
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = 1
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 72
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
             Else
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = False
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 72
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
             End If
             End With
             Next i
End Sub

 

[Shadkng]

Hi, I just realized it seems to work properly in the sheet that is selected when I run the code. If I am in "PACK SLIP", then it will format there correctly and not in the other two.

 

[jolivanes]

If you put lc and GT in its proper place, does that make a difference?

Sub PRINT_RANGE_AUTO_PREVIEW2()
 Dim lc As Long, GT As Long
 Dim shArr, i As Long
            shArr = Array("MASTER FORM", "PACK SLIP", "INVOICE")    '<---- Sheets that the macro should work on. Change to your requirements
            For i = LBound(shArr) To UBound(shArr)
            With Sheets(shArr(i))
            lc = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            GT = .Cells(1, 1).Value
            .PageSetup.PrintArea = Range("A3:A" & GT).Resize(, lc).Address
            .PageSetup.Orientation = xlLandscape
            .PageSetup.Zoom = False
             If Range("A1") <= 45 Then
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = 1
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 72
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
             Else
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = False
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 72
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
             End If
             End With
             Next i
End Sub