vba - Fastest way to delete rows which cannot be grabbed with SpecialCells

Question

Based on another question on this site I started wondering about the fastest way to delete all rows with a certain condition.

The above-referenced question came with various solutions:

(1) Loop through all rows on the sheet (backward) and delete all rows one-by-one which meet the condition.

(2) Move the applicable range into an array first and then evaluate the conditions in the array and -- based on that -- delete all rows one-by-one on the underlying sheet.

A possible improvement might be to delete all rows in chunks to reduce the overhead of accessing to the worksheet. But if you go this route then you have various options to "store" the ranges before you actually delete them:

(1) Use Intersect to merge the ranges which should be deleted.

(2) Simply write a String with all the rows to be deleted.

So, which is the fastest way to do that?

Answer 1

One efficient solution is to tag all the rows to keep and move all the rows to delete at the end by sorting the tags. This way, the complexity doesn't increase with the number of rows to delete.

This example deletes in less than a second, for 50000 rows, all the rows where column I is equal to 2:

Sub DeleteMatchingRows()
    Dim rgTable As Range, rgTags As Range, data(), tags(), count&, r&

    ' load the data in an array
    Set rgTable = ActiveSheet.UsedRange
    data = rgTable.Value

    ' tag all the rows to keep with the row number. Leave empty otherwise.
    ReDim tags(1 To UBound(data), 1 To 1)
    tags(1, 1) = 1  ' keep the header
    For r = 2 To UBound(data)
      If data(r, 9) <> 2 Then tags(r, 1) = r  ' if column I <> 2 keep the row
    Next

    ' insert the tags in the last column on the right
    Set rgTags = rgTable.Columns(rgTable.Columns.count + 1)
    rgTags.Value = tags

    ' sort the rows on the tags which will move the rows to delete at the end
    Union(rgTable, rgTags).Sort key1:=rgTags, Orientation:=xlTopToBottom, Header:=xlYes
    count = rgTags.End(xlDown).Row

    ' delete the tags on the right and the rows that weren't tagged
    rgTags.EntireColumn.Delete
    rgTable.Resize(UBound(data) - count + 1).Offset(count).EntireRow.Delete
End Sub

Note that it doesn't alter the order of the rows.