Print excel report to pdf faster

Question

I'm attempting to print a report in Excel, I need it to be able to print quickly. As it stands it takes forever to go through. Roughly one to two thousand rows of data, per report, per day. Here is the vba for the report. Anything I could change to make the print to pdf functionality happen in much less time?

Sub TestRun()
Dim rSheet As Worksheet
Dim sSheet As Worksheet
Dim mSheet As Worksheet
Dim rRow As Long
Dim sRow As Long
Dim iRow As Long
Dim nRow As Long
Dim mRow As Long
Set mSheet = ThisWorkbook.Worksheets("Report")
Set rSheet = ThisWorkbook.Worksheets("Received")
Set sSheet = ThisWorkbook.Worksheets("Shipped")
rRow = rSheet.Cells(Rows.Count, 1).End(xlUp).Row
sRow = sSheet.Cells(Rows.Count, 1).End(xlUp).Row
mRow = mSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
mSheet.Range("A7:G" & mRow).ClearContents
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With rSheet
    .Range("A1:N" & rRow).AutoFilter Field:=6, Criteria1:=">=" & Sheet5.Range("B3"), Operator:=xlAnd, _
                                Criteria2:="<=" & Sheet5.Range("B4")
    .Range("F2:F" & rRow).Copy
        mSheet.Range("A" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("B2:B" & rRow).Copy
        mSheet.Range("B" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("J2:J" & rRow).Copy
        mSheet.Range("C" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("D2:D" & rRow).Copy
        mSheet.Range("D" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("N2:N" & rRow).Copy
        mSheet.Range("E" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("A2:A" & rRow).Copy
        mSheet.Range("G" & mRow).PasteSpecial Paste:=xlPasteValues
    .AutoFilterMode = False
End With
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With sSheet
    .Range("A1:N" & rRow).AutoFilter Field:=6, Criteria1:=">=" & Sheet5.Range("B3"), Operator:=xlAnd, _
                                Criteria2:="<=" & Sheet5.Range("B4")
    .Range("F2:F" & rRow).Copy
        mSheet.Range("A" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("B2:B" & rRow).Copy
        mSheet.Range("B" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("J2:J" & rRow).Copy
        mSheet.Range("C" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("D2:D" & rRow).Copy
        mSheet.Range("D" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("N2:N" & rRow).Copy
        mSheet.Range("E" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("A2:A" & rRow).Copy
        mSheet.Range("G" & mRow).PasteSpecial Paste:=xlPasteValues
    .AutoFilterMode = False
End With
For i = 7 To mRow
    mSheet.Cells(i, "F") = mSheet.Cells(i, "D") * mSheet.Cells(i, "E")
Next
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
mSheet.Range("D" & mRow + 3) = "TOTAL GROSS LBS"
mSheet.Range("E" & mRow + 3) = "TOTAL DAYS"
mSheet.Range("F" & mRow + 3) = "TOTAL BILLABLE LBS"
mSheet.Range("D" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("D7:D" & mRow))
mSheet.Range("E" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("E7:E" & mRow))
mSheet.Range("F" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("F7:F" & mRow))
If Not Right(Sheet5.Range("B2"), 1) = "\" Then Sheet5.Range("B2") = Sheet5.Range("B2") & "\"
mSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Sheet5.Range("B2") & "\" & Sheet5.Range("D2"), Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub

Link to worksheet: https://mega.co.nz/#!7oRCkQgT!cTzSXQ28oZ5UR_DCkIRJ8BegYEAKqQXN_PLgyQjIJtI

Answer 1

One obvious improvement is to avoid the PasteSpecial method, you can do this instead which should be a little faster:

mSheet.Range("A" & mRow).Value = .Range("F2:F" & rRow).Value

I am certain it will be faster but I did not test it for performance.

Also, this block could be time-consuming on 2000 rows of data (simple tests I did took about 20-25 seconds with a volatile Rand function.

For i = 7 To mRow
    mSheet.Cells(i, "F") = mSheet.Cells(i, "D") * mSheet.Cells(i, "E")
Next

Typically, it is faster to perform arithmetic in memory, rather than on the worksheet object. So let's test out how much faster. The first method I have uses the method above: directly writing a cell value as the product of two other cell's values:

Sub testRangeMultiplication()
Dim i As Integer, mrow As Integer

mrow = 2000

Range("B1:C2000").Formula = "=Rand()"

Debug.Print "Start range multiplication: " & TimeValue(Now)
For i = 1 To 2000

    Cells(i, "A").Value = Cells(i, "B").Value & Cells(i, "C").Value

Next
Debug.Print "End range multiplication: " & TimeValue(Now)

End Sub

This took 20-25 seconds to write 2000 individual cell values as 2000 operations inside the loop.

The alternative method first copies the range to an array, and does all the math in memory, and then writes to the worksheet once. Because accessing the worksheet is expensive (memory-wise), it's best to minimize how often you interact with it. This method does the "loop" without touching the sheet, and only writes to the sheet once, instead of 2000 times.

It takes less than 2 seconds to do the same amount of math:

Sub testArrayMultiplication()
Dim i As Integer, mrow As Integer
Dim arr As Variant

mrow = 2000

Range("B1:C2000").Formula = "=Rand()"

arr = Range("A1:C2000").Value

Debug.Print "Start array multiplication: " & TimeValue(Now)
For i = 1 To 2000

    arr(i, 1) = arr(i, 2) * arr(i, 3)

Next
Range("A1:C2000").Value = arr
Debug.Print "End array multiplication: " & TimeValue(Now)

End Sub

So that one simple change speeds up your loop by about 95%.

other obvious suggestions also include disabling screenupdating (Application.ScreenUpdating = False at the beginning of the sub and =True at the end) and also disabling calculation temporarily (Application.Calculation = xlCalculationManual at the beginning, then =xlCalculationAutomatic at the end of the sub).