Printing to PDF, I can't set the proper active area-CodePudding

This is what I am working on. I have a workbook that is exporting data, running data through a couple of other macros to sort and format it before inserting the data into a formatted worksheet that will have a "Print to PDF" button. What I am running into is that the print area on this ends up printing hundreds of pages.

My suspicion is that this is happening because I use an excel formula that is modifying the data in every column. The answer MAY be to write this out as VBA code instead of nesting the formulas in the columns. But I think it is counting the cells down through these rows because it has a formula even though the cell itself is blank. Does that make sense? Or can you see any other problems??

Option Explicit
Const EXPORTS As String = "P:\Public\Generated Letters\LTXN Export Spreadsheets\"

Sub Create_PDF()
    
    Dim ws As Worksheet
    Dim AccountNumber As String, dt As String, FullName As String, fName As String, sep As String
    Dim myrange As String
    
        
    Set ws = ActiveSheet
    AccountNumber = Right(ws.Range("A3").Value, 3) 'not just `A3`
    
 

'sets the string end for the print area

myrange = Cells(Rows.Count, 6).End(xlUp).Address

With ActiveSheet.PageSetup
        .PrintArea = "A1:" & myrange
           .Orientation = xlLandscape
           .Zoom = False
                   .FitToPagesTall = False
                   .FitToPagesWide = 1
End With
    
    dt = Format(Now, "mm.dd.yyyy hh mm")
    fName = EXPORTS & "AccountEnding" & AccountNumber & " - Created On - "
    
    If Len(Dir(fName & ".pdf")) > 0 Then sep = " - "
    fName = fName & sep & dt & ".pdf"
    
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
        
    Call Shell("explorer.exe" & " " & "P:\Public\Generated Letters\LTXN Export Spreadsheets\", vbNormalFocus)
    
End Sub

So I found an update as I have been milling around on this, it seems like a copy and insert function is causing the issue here. I have this code run before the print to pdf code:

Sub Data_Filter()

If CountRows = ThisWorkbook.Worksheets("LTXN Data").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count > 5000 Then
    MsgBox ("Due to the number of transactions please reach out to David Wallenburg for assistance.")
    Exit Sub
End If

Application.DisplayAlerts = False

Sheets("LTXN Data").Select
Range("A2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

Sheets("LTXN Formatting").Select
Range("A1:I1").PasteSpecial

Application.CutCopyMode = False

  
Sheets("LTXN Formatting").Select

    
    Range("M1:R1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Worksheets("LTXN Formatting Sort").Visible = True
Sheets("LTXN Formatting Sort").Select
Range("a1:f1").PasteSpecial xlPasteValues
Application.CutCopyMode = False

Columns("A:F").Sort key1:=Range("E1"), Order1:=xlDescending

Range("A1:F1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Worksheets("LTXN Report").Visible = True



Sheets("LTXN Report").Select
Range("A6:F6").Select
    Selection.Insert xlShiftDown

Application.CutCopyMode = False

    Dim myrange As String

myrange = Cells(Rows.Count, 6).End(xlUp).Address

Sheets("LTXN Report").Range(Selection, ("a1:" & myrange)).Select
ActiveSheet.Range("A1:" & myrange).BorderAround ColorIndex:=1, Weight:=xlThick
    

Application.DisplayAlerts = True

Sheets("LTXN Report").Activate



End Sub

I think the problem is that when it goes to the LTXN Formatting Sort page it is selecting much more than the columns with DATA. IS there an easy fix i am missing?

CodePudding user response：

Two ways to go about this then. The first one is to use array formulas, specifically Filter(Range,criteria) and depending on how complicated the data is, you might want to have a separate row to determine what data to include. In my example I'm using:

=COUNTIF(E2:G2,"-/-")<>3

Then I have the "Output Report" section, which can be moved to separate page if need be, by using the formula:

=FILTER(E2:G31,I2:I31)

(to note, I'm using "-/-" instead of "" just to help show the blank spaces.)

You Can now confidently use range("somerange").end(xlup).row to find last row

OR -

If you have no blank rows, you can use Sheet4.Range("E:E").Find(what:="", LookIn:=xlValues).Row -1 and that will give you the first row without data.

However, if you have some rows that may have nothing in them, you might want to pull the data into an array and step backwards through it to find last row:

Option Explicit
Sub Set_Print_Area()

Dim I
Dim iLow As Long
Dim iHigh As Long
Dim RG

iHigh = Sheet4.Range("E" & Rows.Count).End(xlUp).Row

Set RG = Sheet4.Range("E1:E" & iHigh)

For I = iHigh To 1 Step -1
    If RG(I) <> "" Then
        Debug.Print I
        ActiveSheet.PageSetup.PrintArea = "E1:G" & I
        Exit For
    End If
Next I

End Sub

Hopefully one of these methods helps.