Slow Excel VBA code

Question

I have tried to write a code that will look at cells in B2 from Row 4 to R2000 and if the content is zero then hide the row. My problem is that the code is running very slow and often stops responding. If you can help me what it is that is causing it to run slow, I can probably fix it myself, but I am not sure what would be a more efficient approach. As you can see I have tried with turning screen updates off, but it didn’t help much.

The code is below

Sub HideRows()

   BeginRow = 4
   EndRow = 2059
   ChkCol = 2

   Application.ScreenUpdating = False

   Rows("1:2059").EntireRow.Hidden = False


   For RowCnt = BeginRow To EndRow
       If Cells(RowCnt, ChkCol).Value = 0 Then
           Cells(RowCnt, ChkCol).EntireRow.Hidden = True
       End If
   Next RowCnt

   Application.ScreenUpdating = True

End Sub

Answer 1

Can you use Autofilter?

---

Option Explicit

Public Sub HideRowsWhereColBis0()

    ActiveSheet.Range("B4:B2059").AutoFilter Field:=1, Criteria1:="<>0"

End Sub

---

Answer 2

Without seeing your workbook, it's hard to know for sure, but generally Excel is pretty slow at hiding rows. In your code, each row is hidden one at a time, so that's potentially 1000+ individual "hide this row" commands to Excel.

It's much faster to hide the rows in "chunks". This macro (I wrote it ages ago because I was dealing with the same problem) does that, so it should be much faster. In your case, you'd call it like this:

Call hideRows(ActiveSheet, 4, 2059, 0, 2, 2)

There's also an inverted setting that would hide rows unless the value in column 2 was equal to zero. You'd just add "True" to the end of your function call.

Sub hideRows(ws As Worksheet, startRow As Long, endRow As Long, valCrit As Variant, Optional startCol As Long = 1, Optional endCol As Long = 1, Optional invert As Boolean = False)

    Dim loopCounter As Long
    Dim rowCounter As Long
    Dim colCounter As Long
    Dim endConsRow As Long
    Dim tempArr As Variant
    Dim toAdd As Long
    Dim toHide As String
    Dim sameVal As Boolean
    Dim consBool As Boolean
    Dim tempBool As Boolean
    Dim rowStr As String
    Dim goAhead As Boolean
    Dim i As Long

    If startRow > endRow Then
        toAdd = endRow - 1
    Else
        toAdd = startRow - 1
    End If

    tempArr = ws.Range(ws.Cells(startRow, startCol), ws.Cells(endRow, endCol)).Value

    ws.Rows(startRow & ":" & endRow).Hidden = False

    loopCounter = 1
    For rowCounter = LBound(tempArr, 1) To UBound(tempArr, 1)
        For colCounter = LBound(tempArr, 2) To UBound(tempArr, 2)
            sameVal = False
            goAhead = False
            If IsNumeric(valCrit) Then
                If tempArr(rowCounter, colCounter) = valCrit Then
                    sameVal = True
                End If
            Else
                If tempArr(rowCounter, colCounter) Like valCrit Then
                    sameVal = True
                End If
            End If
            If sameVal Then
                If invert = True Then
                    loopCounter = loopCounter + 1
                    Exit For
                End If
                goAhead = True
            ElseIf colCounter = UBound(tempArr, 2) Then
                If invert = False Then
                    loopCounter = loopCounter + 1
                    Exit For
                End If
                goAhead = True
            End If
            If goAhead = True Then
                endConsRow = rowCounter
                consBool = True
                Do Until consBool = False
                    tempBool = False
                    For i = LBound(tempArr, 2) To UBound(tempArr, 2)
                        sameVal = False
                        If endConsRow = UBound(tempArr, 1) Then
                            Exit For
                        ElseIf IsNumeric(valCrit) Then
                            If tempArr(endConsRow + 1, i) = valCrit Then
                                sameVal = True
                            End If
                        Else
                            If tempArr(endConsRow + 1, i) Like valCrit Then
                                sameVal = True
                            End If
                        End If
                        If sameVal Then
                            If invert = False Then
                                endConsRow = endConsRow + 1
                                tempBool = True
                            End If
                            Exit For
                        ElseIf i = UBound(tempArr, 2) Then
                            If invert = True Then
                                endConsRow = endConsRow + 1
                                tempBool = True
                            End If
                        End If
                    Next
                    If tempBool = False Then
                        consBool = False
                    End If
                Loop
                rowStr = loopCounter + toAdd & ":" & endConsRow + toAdd
                If toHide = "" Then
                    toHide = rowStr
                ElseIf Len(toHide & "," & rowStr) > 255 Then
                    ws.Range(toHide).EntireRow.Hidden = True
                    toHide = rowStr
                Else
                    toHide = toHide & "," & rowStr
                End If
                loopCounter = loopCounter + 1 + (endConsRow - rowCounter)
                rowCounter = endConsRow
                Exit For
            End If
        Next
    Next

    If Not toHide = "" Then
        ws.Range(toHide).EntireRow.Hidden = True
    End If

End Sub

Answer 3

Try hiding everything in one go instead of every time a 0 is found

Sub HideRows()
    Dim BeginRow As Long, EndRow As Long, ChkCol As Long
    Dim HideRng As Range

    BeginRow = 4
    EndRow = 2059
    ChkCol = 2

    Application.ScreenUpdating = False

    Rows("1:2059").EntireRow.Hidden = False

    For rowcnt = BeginRow To EndRow
        If Cells(rowcnt, ChkCol).Value2 = 0 Then
            If HideRng Is Nothing Then
                Set HideRng = Cells(rowcnt, ChkCol)
            Else
                HideRng = Union(HideRng, Cells(rowcnt, ChkCol))
            End If
        End If
    Next rowcnt

    If Not HideRng Is Nothing Then HideRng.EntireRow.Hidden = True

    Application.ScreenUpdating = True

End Sub