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

 

[Shadkng]

This works. What would be the line to add row heights?

 

[Shadkng]

What do you get if you'd tried

MsgBox Cells(1, 27).Left

Hi, actually I don't think this is doing what I need. This seems to be adding all the columns widths through column 26. Maybe we can use a row number, say row 24, as the criteria and add sum the widths of all cell with data? However, the formula must not consider columns that are hidden which contain data. Basically I am trying to draw the width of visible data into a numeric value. If successful I would need the same for rows. Thanks

 

[jolivanes]

Sub Maybe()
Dim lr As Long, lc As Long, hite As Double, wits As Double
Dim i As Long, ii As Long
lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
wits = 0
hite = 0

    For i = 1 To lc
        If Columns(i).Hidden = False Then wits = wits + Columns(i).Width
    Next i
    
    For ii = 1 To lr
        If Rows(ii).Hidden = False Then hite = hite + Rows(ii).Height
    Next ii
    
MsgBox "Total Height = " & hite & ", Total Width = " & wits
wits = 0
hite = 0
End Sub

 

[Shadkng]

Thank you. I am going to try on my own first to add your code to mine. If I need help I will ask you to check it.

 

[Shadkng]

I don't think I can do it on my own. Below is the previous code you helped me with earlier in the thread which I combined with some other code to create the PDF file. I had been using the value in cell "B2" as the last row, but I guess that is not needed when using the last row find. So can we make the following work?

Create the print range the same way from cell "A4" to the last visible column and row - like the new code you wrote.

I would need to set the criteria for the maximum column width and row height to decide if range output should be landscape or portrait. For example, if the width if more than 900 is will output landscape, if less than portrait. However, if it is less than 900, can we have an message box to say "do you want this in portrait?" and Yes to continue and no to continue in Landscape.

I can use the code you wrote in the last post to come up with the row and column totals that I will need to put into the code. Yo may put any number in for now.

The rest of my code works fine and can remain.

Thanks and I hope it's not too much work. Just want you to know I appreciate it...you have no idea how this helps save time in my everyday business.

Sub DETAIL_PDF2_REPLACE_FILE_AUTO_RANGE_LAND()
    Dim response As String
    Dim PrintAreaString As String
    Dim fpath As String
    Dim fName As String
    Dim fileSaveName As String, filePath As String
    Dim reply As Variant
    Dim lc As Long, GT As Long
    Dim shArr, i As Long
    
    shArr = Array("DETAIL FORM2") '<---- 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, 2).Value
            .PageSetup.PrintArea = Range("A4:A" & GT).Resize(, lc).Address
            .PageSetup.Orientation = xlLandscape
            .PageSetup.Zoom = False
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = False
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 36
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
    End With
    Next i
    fileSaveName = "FRIEDLAND QUOTE " & [B6] & " " & "JOB " & [B7] & " " & [A29] & " " & [AB29] & " " & [AC29] & [B9] & " PCS" & " " & Format(Date, "mmddyy")
    
    filePath = ActiveWorkbook.Path & "\" & fileSaveName & ".pdf"
    
    reply = vbNo
    While Dir(filePath) <> vbNullString And fileSaveName <> "" And reply = vbNo
        reply = MsgBox("THE PDF " & fileSaveName & " ALREADY EXISTS." & vbCrLf & vbCrLf & "DO YOU WANT TO REPLACE THE FILE?  CHOOSE NO TO RENAME.", vbYesNo, "Save as PDF")
        If reply = vbNo Then
            fileSaveName = InputBox("Please enter a new file name:", "Save as PDF", fileSaveName)
        End If
        filePath = ActiveWorkbook.Path & "\" & fileSaveName & ".pdf"
    Wend
        
    If fileSaveName <> "" Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True '(change this to "False" to prevent the file from opening after saving)
    Else
        MsgBox "PDF not created"
    End If
    End Sub

 

[Shadkng]

Hi Jolivanes, was wondering if you had a chance to take a look at my last post. The code from post #23 works fine and was hoping you could incorporate into the above code. I just don' t know enough to make this work. Thanks again.

 

[jolivanes]

Not tested.

At the top:

Dim witsMsg As String

Replace your

.PageSetup.Orientation = xlLandscape

with

If wits > 900 Then
.PageSetup.Orientation = xlLandscape
Else
witsMsg = MsgBox("Width is " & wits &". Do you want to print in portrait mode?", vbyesno,"Printing Options.")
If witsMsg = vbyes Then
.PageSetup.Orientation = xlPortrait
Else
.PageSetup.Orientation = xlLandscape
End If
End If

 

[Shadkng]

Thanks for the reply. So I inserted the code, but can the code from post #23 be added so the column and row widths will be computed within the program? Wouldn't the code in #23 replace the section starting with shArr = Array("DETAIL FORM2")?

Can we have a statement if wits is less than 900 and hite is less than say 1200 than print in portrait mode and keep the message box to give the option.

Sub DETAIL_FORM2_PDF_REPLACE_FILE_AUTO_RANGE_BY_WIDTH_TESTING()
     Dim response As String
    Dim PrintAreaString As String
    Dim fpath As String
    Dim fName As String
    Dim fileSaveName As String, filePath As String
    Dim reply As Variant
    Dim lc As Long, GT As Long
    Dim shArr, i As Long
    Dim witsMsg As String
    
            shArr = Array("DETAIL FORM2") '<---- 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, 2).Value
            .PageSetup.PrintArea = Range("A4:A" & GT).Resize(, lc).Address
If wits > 900 Then
.PageSetup.Orientation = xlLandscape
Else
witsMsg = MsgBox("Width is " & wits & ". Do you want to print in portrait mode?", vbYesNo, "Printing Options.")
If witsMsg = vbYes Then
.PageSetup.Orientation = xlPortrait
Else
.PageSetup.Orientation = xlLandscape
End If
End If
            .PageSetup.Zoom = False
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = False
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 36
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
    End With
    Next i
    fileSaveName = "FRIEDLAND QUOTE " & [B7] & " " & "JOB " & [B8] & " " & [A30] & " " & [AB30] & " " & [AC30] & [B10] & " PCS" & " " & Format(Date, "mmddyy")
    
    filePath = ActiveWorkbook.Path & "\" & fileSaveName & ".pdf"
    
    reply = vbNo
    While Dir(filePath) <> vbNullString And fileSaveName <> "" And reply = vbNo
        reply = MsgBox("THE PDF " & fileSaveName & " ALREADY EXISTS." & vbCrLf & vbCrLf & "DO YOU WANT TO REPLACE THE FILE?  CHOOSE NO TO RENAME.", vbYesNo, "Save as PDF")
        If reply = vbNo Then
            fileSaveName = InputBox("Please enter a new file name:", "Save as PDF", fileSaveName)
        End If
        filePath = ActiveWorkbook.Path & "\" & fileSaveName & ".pdf"
    Wend
        
    If fileSaveName <> "" Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True '(change this to "False" to prevent the file from opening after saving)
    Else
        MsgBox "PDF not created"
    End If
    End Sub

 

[jolivanes]

That are just some variable calculations to be used later on in the code.
That can be inserted right below the last Dim statement. (Take the MsgBox line out though.)
This following line has to be removed from your current code.

lc = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column

because it will be earlier on in the code now.
Re:if wits is less than 900 and hite is less than say 1200
Where do you want this?

 

[Shadkng]

Hi, I made the changes as you described above and the program seems to be running OK. I want to test more scenarios as I don't want to ask you questions one at time. I'll be back to you either way to let you know how it's going and I may ask you to look at the final code to make sure it's clean after my changes. Thanks again.