Speed Up Macro / VBA

**zhb12810** · 07-23-2012, 06:21 AM

Hi,

I have the following VBA code/Macro which is attached to a button on a user form which does the following:

1) Checks which version of Excel a PC is running then if it is using XL2007 + performs the code or else advises how to procede
2) Once checked it then checks a cell on a specific sheet and depending on the value hides cells and adjust page breaks
3) It then prints to PDf

The problem is its so very slow and just wonderd if there was a way of speeding it up a bit

Many Thanks

Private Sub CommandButton1_Click()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim r As Integer
Dim k As Integer
Dim Evers As Long
Dim Mailbox As String
Dim rRng As Excel.Range

' Get Excel Version

    If Val(Application.Version) < 12 Then
     Evers = 11
        'You use Excel 97-2003
    Else
     Evers = 12
        'You use Excel 2007 or higher
    End If
    
    Sheets("Report").Visible = True
    Sheets("Report").Select
    Range("D9").Select
    Cells.CheckSpelling SpellLang:=2057
    

'Clear all existing page breaks
    
    Sheets("Report").ResetAllPageBreaks

    
Select Case Sheets("Unit").Range("C1").Value
    
Case Is = "Capcon"
 
     For r = 70 To 50 Step -1
       Sheets("Report").Rows(r).EntireRow.Hidden = True
    Next r
    For r = 43 To 23 Step -1
       Sheets("Report").Rows(r).EntireRow.Hidden = True
    Next r
    
    'set page breaks
    
    Sheets("Report").HPageBreaks.Add before:=Cells(102, 1)
    Sheets("Report").HPageBreaks.Add before:=Cells(149, 1)
    
    
    
 Case Is = "Controller", Is = "Mini Controller"
 
    For r = 43 To 23 Step -1
      k = Len(Sheets("Report").Cells(r, 7)) + Len(Sheets("Report").Cells(r, 8)) + Len(Sheets("Report").Cells(r, 9)) + Len(Sheets("Report").Cells(r, 10))
      Sheets("Report").Rows(r).EntireRow.Hidden = (k = 0)
   
    Next r
    
      
    For r = 70 To 50 Step -1
        k = Len(Sheets("Report").Cells(r, 7)) + Len(Sheets("Report").Cells(r, 8)) + Len(Sheets("Report").Cells(r, 9)) + Len(Sheets("Report").Cells(r, 10))
        Sheets("Report").Rows(r).EntireRow.Hidden = (k = 0)
    Next r
    
    'set page breaks
    
    Sheets("Report").HPageBreaks.Add before:=Cells(78, 1)
    Sheets("Report").HPageBreaks.Add before:=Cells(149, 1)
    
End Select


If Evers = 12 Then
    Mailbox = ActiveWorkbook.Path
    Sheets("Report").Visible = True
    Sheets("Report").Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Mailbox & "\" & "Headline.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    
    Sheets("Report").Visible = False
Else
' We are on Version 2003 or lower...
MsgBox "You are using a version of Excel which is 2003 or lower. You will therefore need to manually print the report to a pdf file called Headline.pdf and save this in the mailbox folder that the stock is saved in", vbOKOnly, "Capcon Headline Report"
Sheets("Report").Visible = True
Sheets("Report").Select
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

**Fettertiger** · 07-29-2012, 12:11 PM

Hi zhb12810,

the slow speed is caused by the multiple hide commands. Instead you should all lines which need to be hidden to a range and then hide the range in one go:

Private Sub CommandButton1_Click()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim r As Integer
    Dim k As Integer
    Dim Evers As Long
    Dim Mailbox As String
    Dim rRng As Excel.Range

    ' Get Excel Version

    If Val(Application.Version) < 12 Then
        Evers = 11
        'You use Excel 97-2003
    Else
        Evers = 12
        'You use Excel 2007 or higher
    End If

    Sheets("Report").Visible = True
    Sheets("Report").Select
    Range("D9").Select
    Cells.CheckSpelling SpellLang:=2057


    'Clear all existing page breaks

    Sheets("Report").ResetAllPageBreaks


    Select Case Sheets("Unit").Range("C1").Value

    Case Is = "Capcon"

        Set Rng = Sheets("Report").Rows("50:70")
        Set Rng = Union(Rng, Rows("23:43"))



        'set page breaks

        Sheets("Report").HPageBreaks.Add before:=Cells(102, 1)
        Sheets("Report").HPageBreaks.Add before:=Cells(149, 1)



    Case Is = "Controller", Is = "Mini Controller"

        For r = 43 To 23 Step -1
            k = Len(Sheets("Report").Cells(r, 7)) + Len(Sheets("Report").Cells(r, 8)) + Len(Sheets("Report").Cells(r, 9)) + Len(Sheets("Report").Cells(r, 10))
            If k = 0 Then
                If IsObject(Rng) = True Then
                    Set Rng = Union(Rng, Sheets("Report").Rows(r))
                Else
                    Set Rng = Sheets("Report").Rows(r)

                End If
            End If
        Next r


        For r = 70 To 50 Step -1
            k = Len(Sheets("Report").Cells(r, 7)) + Len(Sheets("Report").Cells(r, 8)) + Len(Sheets("Report").Cells(r, 9)) + Len(Sheets("Report").Cells(r, 10))
           If k = 0 Then
                If IsObject(Rng) = True Then
                    Set Rng = Union(Rng, Sheets("Report").Rows(r))
                Else
                    Set Rng = Sheets("Report").Rows(r)
                End If
            End If
        Next r

        'set page breaks

        Sheets("Report").HPageBreaks.Add before:=Cells(78, 1)
        Sheets("Report").HPageBreaks.Add before:=Cells(149, 1)

    End Select
    Rng.EntireRow.Hidden = True

    If Evers = 12 Then
        Mailbox = ActiveWorkbook.Path
        Sheets("Report").Visible = True
        Sheets("Report").Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                        Mailbox & "\" & "Headline.pdf", Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                                        True

        Sheets("Report").Visible = False
    Else
        ' We are on Version 2003 or lower...
        MsgBox "You are using a version of Excel which is 2003 or lower. You will therefore need to manually print the report to a pdf file called Headline.pdf and save this in the mailbox folder that the stock is saved in", vbOKOnly, "Capcon Headline Report"
        Sheets("Report").Visible = True
        Sheets("Report").Select
    End If

    set Rng = nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Hope this works for you too.

Regards

Theo