CODEWITHSUNDEEP
excelvba
j2associates
j2associates

Reputation: 1155

How to use VBA to quickly and easily delete unfiltered rows

Recently I ran into a situation where an Excel file was so large it would not copy only filtered rows to a second sheet. Attempting to do so caused Out of Memory errors. I needed to come up with something that was fast, so processing row by row was not an option. Below is the code that I came up with. It deleted 20,000+ rows in just a couple of seconds. The secret was to keep track of contiguous hidden rows and delete them as a block instead of one at a time.

By processing from the last row to the top, I could still iterate the rows without impacting anything as I deleted unfiltered rows. Here is Immediate Window output for reference purposes.

Upvotes: 0

Views: 240

Answers (3)

j2associates
j2associates

Reputation: 1155

Private Sub DeleteUnfilteredRows()
    ' TestSheet is a CodeName.
    Call RemoveHiddenFilterRows(TestSheet, 3)
End Sub

Private Sub RemoveHiddenFilteredRows(Sh As Worksheet, lHeaderRow As Long)
Dim lRow As Long, lBegRow As Long, lEndRow As Long, lRangeBegRow As Long, lRangeEndRow As Long, lBegCol As Long, lEndCol As Long
Dim lCount As Long
Dim bRowHidden As Boolean, bRangeHidden As Boolean
    With Sh
        With .UsedRange
            ' First cell contains beginning row and column.
            With .Cells(1)
                lBegRow = .Row
                lBegCol = .Column
            End With
            ' Last cell contains ending row and column.
            With .Cells(.Cells.Count)
                lEndRow = .Row
                lEndCol = .Column
            End With
        End With
    
        ''Debug.Print "BegRow:"; lBegRow; "EndRow:"; lEndRow; "Begcol:"; lBegCol; "Endcol:"; lEndCol; .Name, .Parent.Name
    
        bRangeHidden = .Rows(lEndRow).Hidden
        lRangeEndRow = lEndRow
        For lRow = lEndRow To lHeaderRow Step -1
            bRowHidden = .Rows(lRow).Hidden
        
            If bRowHidden <> bRangeHidden Then
                If bRangeHidden Then
                    lCount = lCount + 1
                    lRangeBegRow = lRow + 1
                    ''Debug.Print lCount; "Rows("; lRangeBegRow; ":"; lRangeEndRow; ")"
                    Call .Rows(lRangeBegRow & ":" & lRangeEndRow).Delete(Shift:=xlUp)
                End If
            
                bRangeHidden = bRowHidden
                lRangeEndRow = lRow
            End If
        Next

        ' Do not forget the last one.
        If bRangeHidden Then
            lRangeBegRow = lRow + 1
            Call .Rows(lRangeBegRow & ":" & lRangeEndRow).Delete(Shift:=xlUp)
        End If
    End With
End Sub

Upvotes: 0

CDP1802
CDP1802

Reputation: 16174

Alternatively count the number of hidden rows in each block and use Resize().

Private Sub RemoveHiddenRows(Sh As Worksheet, lHeaderRow As Long)

    Dim startrow As Long, endrow As Long
    Dim n As Long, i As Long, t As Long
    Dim t0 As Single: t0 = Timer
     
    n = 0
    With Sh
        If .AutoFilterMode = False Then Exit Sub
        startrow = .AutoFilter.Range.Row
        endrow = .AutoFilter.Range.Rows.Count + startrow - 1
        For i = endrow To startrow Step -1
            If .Rows(i).Hidden Then
                n = n + 1 ' count hidden rows
            ElseIf n > 0 Then
                .Rows(i + 1).Resize(n).Delete Shift:=xlUp
                t = t + n
                n = 0
            End If
        Next
        .AutoFilter.ShowAllData
    End With
    
    MsgBox t & " rows deleted", vbInformation, _
           Format(Timer - t0, "0.0 secs")
End Sub

Upvotes: 1

FaneDuru
FaneDuru

Reputation: 42236

Please, test the next way. It will check the rows visibility of A:A range and create a Union range containing the hidden cells. Then, delete the range EntireRow at the end:

Sub removeHFrows()
  Dim sh As Worksheet, lastR As Long, lHeaderRow As Long, rngA As Range, rngH As Range, i As Long
  
  Set sh = ActiveSheet ' Use here the sheet you need
  lastR = sh.Range("A" & sh.Rows.count).End(xlUp).row    'supposing that A:A is not shorter then other columns...
  lHeaderRow = 3
  Set rngA = sh.Range("A1:A" & lastR)
  
  For i = 3 To lastR
        If rngA.Rows(i).Hidden Then
            If rngH Is Nothing Then
                Set rngH = rngA(i)              'firstly set the range
            Else
                Set rngH = Union(rngH, rngA(i)) 'make a Union between the previous cells in the range and this one
            End If
        End If
  Next i
  'delete the Union range rows, at once:
  If Not rngH Is Nothing Then rngH.EntireRow.Delete
End Sub

Upvotes: 1

Related Questions