简体   繁体   中英

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

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.

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.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM