VBA to update page, save as PDF and repeat is super slow!

[taylrmstrng]

I have a macro that essentially does the following:

1. moves a list of client names up one cell.
2. all the calculations on the table (including arrays) are recalculated based on the new value in cell O2
3. unhides all hidden rows
4. hides all rows with 0 values
5. saves as PDF with the name of a cell reference which updates each time
6. repeat the above until the full list of clients has run through

This takes a few minutes for each PDF. However, I have another version of this macro that doesn't rename the file - the filename is built in to the VBA code and instead of having a looper, there are just multiple occurances of the same VBA code with different file names. It runs significantly faster.

Any thoughts on how I can speed this up as I'd love to keep the custom names!

Thank ya

Application.ScreenUpdating = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    
    ' move all vendor names down one to update data
        
    Sheets("Statement").Select
    Range("O3:O4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("O2").Select
    ActiveSheet.Paste
    
    ' Show only active lines in sales
    
    Rows("156:613").Select
    Selection.EntireRow.Hidden = False

    For Each cell In Range("A156:A613")
        If Not IsEmpty(cell) Then
            If cell.Value = 0 Then
                cell.EntireRow.Hidden = True
            End If
        End If
    Next
    
    ' Show only active lines in refunds
    
    Rows("615:727").Select
    Selection.EntireRow.Hidden = False

    For Each cell In Range("N615:N727")
        If Not IsEmpty(cell) Then
            If cell.Value = 0 Then
                cell.EntireRow.Hidden = True
            End If
        End If
    Next
    
    ' Export as PDF and save as value in U4 ("Artist First - Month Year - Supplier")
    
    
    s = Range("U4").Value
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    s, Quality:=xlQualityStandard, IncludeDocProperties _
    :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    '

Sub Looper()

    With Sheets("Statement")
        '   Test Condition 1
            Do Until .Range("O2") = Range("O3")
                   Application.Run "Save"
            Loop
    End With
End Sub

 

[jolivanes]

After this

 Sheets("Statement").Select
    Range("O3:O4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("O2").Select
    ActiveSheet.Paste

the last entry in Column O is double.
Should that not be deleted?

Or would this work?

Sheets("Statement").Cells(2, 15).Delete Shift:=xlUp

Or does that mess with your formulas?

Or if you want to stay with copy and paste, this would be better (no selecting) and would not leave a double at the end.

With Sheets("Statement")
.Range("O3:O" & .Cells(.Rows.Count, 15).End(xlUp).Row + 1).Copy .Range("O2")
End With

 

[taylrmstrng]

After this

 Sheets("Statement").Select
    Range("O3:O4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("O2").Select
    ActiveSheet.Paste

the last entry in Column O is double.
Should that not be deleted?

Or would this work?

Sheets("Statement").Cells(2, 15).Delete Shift:=xlUp

Or does that mess with your formulas?

Or if you want to stay with copy and paste, this would be better (no selecting) and would not leave a double at the end.

With Sheets("Statement")
.Range("O3:O" & .Cells(.Rows.Count, 15).End(xlUp).Row + 1).Copy .Range("O2")
End With

Thanks for ya reply! It may not be the best solution, but having the last entry double up in column O is what stops the looping.
I.e. it loops until O2 = O3.

I imagine there's a better way for that, but really just looking to fix the PDF speed. When I run it without the PDF saving everything else is really quick.

 

[jolivanes]

Re: "but having the last entry double up in column O is what stops the looping"
I am sure there is a better way.
I'm busy for now and will have a look tomorrow if no one else comes with a solution in the meantime.

 

[taylrmstrng]

Re: "but having the last entry double up in column O is what stops the looping"
I am sure there is a better way.
I'm busy for now and will have a look tomorrow if no one else comes with a solution in the meantime.

thanks, no rush, not the problem I'm trying to solve as its not what's slowing me down after testing removing the PDF save.

 

[GWteB]

@taylrmstrng, you describe what your macro does and that it all works very slowly.
When I take a look at your code, I notice some degree of inconsistency, assuming the first block of code of your post is part of the Save procedure.
Within your data range, your data is copied one row higher within each turn. So after every turn there is a duplicate of the bottom row. Despite that, a static range is examined for whether or not the rows are hidden, when at some point all those rows look exactly the same. Row 614 seemed to have a special meaning since that row is excluded from the examination.
I would advise you to be more specific about what you are trying to achieve, in order to enable others to help you better.

 

[cooper645]

I started looking at your code but ran out of time. I did however think you could rewrite a portion of your code as follows:

Your code:

' Show only active lines in sales
   
    Rows("156:613").Select
    Selection.EntireRow.Hidden = False

    For Each cell In Range("A156:A613")
        If Not IsEmpty(cell) Then
            If cell.Value = 0 Then
                cell.EntireRow.Hidden = True
            End If
        End If
    Next
   
    ' Show only active lines in refunds
   
    Rows("615:727").Select
    Selection.EntireRow.Hidden = False

    For Each cell In Range("N615:N727")
        If Not IsEmpty(cell) Then
            If cell.Value = 0 Then
                cell.EntireRow.Hidden = True
            End If
        End If
    Next

Could be replaced with the following, it omits the empty checks and simply hides the rows with a value of 0, which I believe is what your code does. (leaves the blanks visible)
I'm by no means an expert but I think the reduced number of If Statements should speed things up. It also omits the .Select method which slows things as it accesses the sheet.

Dim Rng As Range, cell As Range

Set Rng = Union(Range("A156:A613"), Range("N615:N727"))

Rng.EntireRow.Hidden = False

For Each cell In Rng
        If cell.Value = "0" Then
            cell.EntireRow.Hidden = True
        End If
Next cell