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

Question

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?

Answer 1

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.