Speeding Up Code that Removes Hidden Rows on a She

Question

Below I have some code that I have written. It is compeletely effective and gives no errors. However, it is very, very slow. The sub takes a given sheet with a table on it and checks for hidden rows. If all the rows are hidden, it deletes the sheet. If not, then it deletes all the hidden rows.

This is run in another sub, where all things like screenupdating and events are disabled.

I have researched common ways to speed up code (here: How to improve the speed of VBA macro code?, here: http://www.databison.com/how-to-speed-up-calculation-and-improve-performance-of-excel-and-vba/, and here: http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm), but haven't been able to apply too many of them.

Please take a look and let me know what you think I could do to speed this up. If there are any other proper coding mistakes I have made, please let me know those as well.

Thanks!

Sub RhidRow(ByVal count4 As Double) 'count 4 is the total number of possible rows
Dim count6, count1, count9 As Double 'counters to be used

    count6 = 2 'begin on row two
    count1 = 0 'check for visible rows counter

    With ActiveSheet
        While count6 < count4
            DoEvents
            Application.StatusBar = "Checking row " & count6 & " of " & count4 & "."
            If Range("A" & CStr(count6)).EntireRow.Hidden = False Then
                count1 = count1 + 1 'if there was a visible row, then add one
            End If
            count6 = count6 + 1 'move to next row to check
        Wend

        Range("N7") = count6 'so I can hand check results

        If count1 = 0 Then 'if there were no visible rows, then set Z1 to 1 and exit
            Range("Z1").Value = 1 'to error check in another sub. if Z1=1, then delete
            Exit Sub
        End If

        count6 = 2 'start on row 2
        count9 = 1 'count 9
        While count9 < count4 'while the row is less than the count of the total rows
            DoEvents
            Application.StatusBar = count6 & " or " & count9 & " of " & count4
            If Range("A" & CStr(count6)).EntireRow.Hidden = True Then
                Range("A" & CStr(count6)).EntireRow.Delete 'if row is hidden, delete
            Else
            count6 = count6 + 1 'if it is not hidden, move to the next row
            End If
            count9 = count9 + 1 'show what row it is on in the status bar
        Wend
    End With
End Sub

I have made the change suggested in the comments and gotten rid of ActiveSheet. The speed was unaffected.

Sub RhidRow(ByVal count4 As Double, shtO As Object) 'count 4 is the total number of possible rows
Dim count6, count1, count9 As Double 'counters to be used

count6 = 2 'begin on row two
count1 = 0 'check for visible rows counter

With shtO
    While count6 < count4
        DoEvents
        Application.StatusBar = "Checking row " & count6 & " of " & count4 & "."
        If Range("A" & CStr(count6)).EntireRow.Hidden = False Then
            count1 = count1 + 1 'if there was a visible row, then add one
        End If
        count6 = count6 + 1 'move to next row to check
    Wend

    Range("N7") = count6 'so I can hand check results

    If count1 = 0 Then 'if there were no visible rows, then set Z1 to 1 and exit the sub
        Range("Z1").Value = 1 'this is used to error check in another sub. if Z1 is 1, then the sheet is deleted
        Exit Sub
    End If

    count6 = 2 'start on row 2
    count9 = 1 'count 9
    While count9 < count4 'while the row is less than the count of the total rows
        DoEvents
        Application.StatusBar = "Deleting hidden rows. " & count6 & " or " & count9 & " of " & count4 & " done."
        If Range("A" & CStr(count6)).EntireRow.Hidden = True Then
            Range("A" & CStr(count6)).EntireRow.Delete 'if the row is hidden, delete it
        Else
        count6 = count6 + 1 'if it is not hidden, move to the next row
        End If
        count9 = count9 + 1 'show what row it is on in the status bar
    Wend
End With
End Sub

Answer 1

the below will delete the sheet (or flag I left the logic for you to decide) if all rows are hidden, or will delete only the hidden rows if not:

Dim rngData As Range, rngVisible As Range, rngHidden As Range

Set rngData = Range("C8:H20")
Set rngVisible = rngData.SpecialCells(xlCellTypeVisible)
Set rngHidden = Range("A:A")

    If (rngVisible Is Nothing) Then

        ' delete sheet or flag
    Else

        ' invert hidden / visible
        rngHidden.Rows.Hidden = False
        rngVisible.Rows.Hidden = True

        ' delete hidden and show visible
        rngData.SpecialCells(xlCellTypeVisible).Delete
        rngVisible.Rows.Hidden = False

    End If

Answer 2

This might be a bit quicker:

Sub RowKleaner()
    Dim rBig As Range, r As Range, rDelete As Range
    ActiveSheet.UsedRange
    Set rBig = Intersect(ActiveSheet.UsedRange, Range("A:A"))
    Set rDelete = Nothing
    For Each r In rBig
        If r.EntireRow.Hidden = True Then
            If rDelete Is Nothing Then
                Set rDelete = r
            Else
                Set rDelete = Union(rDelete, r)
            End If
        End If
    Next r

    If Not rDelete Is Nothing Then
    rDelete.EntireRow.Delete
    End If

End Sub

Answer 3

Maybe something like this:

Sub RhidRow(ByVal count4 As Double) 'count 4 should be a Long, not Double
    Dim count1 As Long 'counters to be used
    Dim ws As Worksheet
    Dim rngVis As Range
    Dim rngDel As Range
    Set ws = ActiveSheet

    On Error Resume Next
    Set rngVis = ws.Range("A2:A" & count4).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rngVis Is Nothing Then
        ws.Range("Z1").Value = 1
    Else

        For count1 = count4 To 2 Step -1
            If ws.Rows(count1).Hidden = True Then
                If rngDel Is Nothing Then
                    Set rngDel = ws.Rows(count1)
                Else
                    Set rngDel = Union(rngDel, ws.Rows(count1))
                End If
            End If
        Next count1

    If Not rngDel Is Nothing Then
        Application.DisplayAlerts = False
        Intersect(rngDel, rngDel.ListObject.DataBodyRange).Delete 'if row is hidden, delete
        Application.DisplayAlerts = True
    End If

    End If
End Sub