CODEWITHSUNDEEP
vbaexcel
isic5
isic5

Reputation: 191

Improve speed on Macro hiding rows

I have a macro that is used to hide rows that are not relevant for the selected Customer. But since my report has gotten bigger and bigger, the macro is getting way to slow.

I am looking for a way to improve the speed on this macro, as of now its running over 4 minutes.

Here is the code:

Private Sub Worksheet_Calculate()
Dim LastRow As Long, c As Range

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LastRow = Cells(Cells.Rows.Count, "CP").End(xlUp).Row
On Error Resume Next
For Each c In Range("CP1:CP" & LastRow)
   If c.Value = 0 Then
        c.EntireRow.Hidden = True
    ElseIf c.Value > 0 Then
        c.EntireRow.Hidden = False
    End If
Next
On Error GoTo 0

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Upvotes: 1

Views: 177

Answers (3)

Vityata
Vityata

Reputation: 43585

It is really a strange design decision to hide and unhide rows, based on their values and to implement it in a _Calculation event. However, there is a way to make it significantly faster, if you combine all the rows that have to be hidden to one range and all the rows that have to be shown in another:

Public Sub HideQuickly()    

    Dim wholeRangeV As Range, wholeRangeNV As Range, myCell As Range, lastRow As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False        
    lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row

    For Each myCell In Range("A1:A" & lastRow)            
        Select Case myCell
        Case Is > 0
            If wholeRangeV Is Nothing Then
                Set wholeRangeV = myCell
            Else
                Set wholeRangeV = Union(wholeRangeV, myCell)
            End If
        Case Is = 0
            If wholeRangeNV Is Nothing Then
                Set wholeRangeNV = myCell
            Else
                Set wholeRangeNV = Union(wholeRangeNV, myCell)
            End If
        End Select
    Next myCell

    If Not wholeRangeNV Is Nothing Then
        wholeRangeNV.EntireRow.Hidden = True
    End If        
    If Not wholeRangeV Is Nothing Then
        wholeRangeV.EntireRow.Hidden = False
    End If

    Application.EnableEvents = True
    Application.ScreenUpdating = True        
End Sub

As you see, with the above code, the hiding/unhiding action is carried out only once per type:

wholeRangeV.EntireRow.Hidden = False
wholeRangeNV.EntireRow.Hidden = True

Concerning the setting the calculation to manual in Excel, this is sometimes considered a bad habit, thus try to avoid it.

Upvotes: 1

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19782

As @SJR said - use an AutoFilter.
Change the VisibleDropDown property to TRUE if you want to see the filter arrow. 

Private Sub Worksheet_Calculate()

    Dim LastRow As Long

    LastRow = Cells(Cells.Rows.Count, "CP").End(xlUp).Row

    With ActiveSheet
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If

        .Range(.Cells(1, "CP"), .Cells(LastRow, "CP")).AutoFilter _
            Field:=1, _
            Criteria1:=">0", _
            Operator:=xlAnd, _
            VisibleDropDown:=False

    End With

End Sub

Edit: After testing it filtered 139987 rows in 93ms.

Timing code: 

Private Declare Function GetTickCount Lib "kernel32" () As Long

Public CodeTimer As Long

'^^^^^ Top of module ^^^^^^

Public Function StartTimer()
    CodeTimer = GetTickCount
End Function

Public Function StopTimer()
    Dim FinalTime As Long
    FinalTime = GetTickCount - CodeTimer
    MsgBox Format(Now(), "ddd dd-mmm-yy hh:mm:ss") & vbCr & vbCr & _
            Format((FinalTime / 1000) / 86400, "hh:mm:ss") & vbCr & _
            FinalTime & " ms.", vbOKOnly + vbInformation, _
        "Code Timer"
    CodeTimer = 0
End Function

Just add StartTimer at top of your code, and StopTimer at the bottom.

Upvotes: 3

EarlyBird2
EarlyBird2

Reputation: 306

In case you don't have negative values, but just zero or positive, skip the ElseIf statement. If you do have, change the Ifstatement to If ... >=0 Then.

Upvotes: 0

Related Questions