Aurelius
Aurelius

Reputation: 485

More efficient way of deleting rows

I have some code that deletes rows that are not in a specified list of row numbers that are to be kept. It functions as intended.

 For lRow = numRowsInBBS To 1 Step -1

    lMatch = 0
    On Error Resume Next
    lMatch = Application.Match(lRow, ws.Range("AE4:AE" & numRows).Value, 0&)
    On Error GoTo 0

    If Not CBool(lMatch) Then
      wsImport.Cells(lRow, 1).EntireRow.Delete
    End If
  Next
End Sub

However, this takes a monumental amount of time. To do this on 150 rows takes a couple of minutes of processing. I have documents that could be 1000s of rows long.

Essentially I want to delete all rows on a specified sheet EXCEPT for the row numbers specified in AE4:AE?? (This is calculated by numRows) on a different sheet.

The data range is not contiguous, AE4:AE?? could list numbers 3,4,5,33,66,101,110 as rows to keep. All other rows are to be deleted.

Is there a better way of achieving my goal here?

I hear autofilter is much faster, but don't see how I can apply it here as I am not matching a string or any content in the cells, simply the row numbers.

EDIT: As per suggestion, I have tried the autofilter way:

Dim rowsToKeep() As Variant: rowsToKeep = ws.Range("AE4:AE" & numRows)
Dim allRows As Range: Set allRows = Range("ZZ1:ZZ" & numRowsInBBS)

With wsImport
.Range(allRows.Address).Formula = "=row()"
.Range(allRows.Address).AutoFilter Field:=1, Criteria1:=rowsToKeep, Operator:=xlFilterValues
.Range(allRows.Address).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range(allRows.Address).AutoFilter Field:=1
End With

I am trying to: Set the data in the range AE4:AE?? as the data for an array - Then use ZZ as a helper column containing row numbers - Then filter out the rows I want to keep - Then delete all visible rows - Then show the rows that were filtered

However, the filter is hiding everything, which suggests to me there is something wrong with rowsToKeep, and yes AE4:AE?? on the other sheet does contain values.

Upvotes: 0

Views: 82

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149297

Try this (Untested)

Deleting rows in a loop will always be slower. What the below code does is that it stores the rows that needs to be deleted in a range object and then deletes them at the end of the loop in One go.

Dim delRng As Range

For lRow = 1 To numRowsInBBS
    On Error Resume Next
    lMatch = Application.Match(lRow, ws.Range("AE4:AE" & numRows).Value, 0&)
    On Error GoTo 0

    If Not CBool(lMatch) Then
        If delRng Is Nothing Then
            Set delRng = wsImport.Rows(lRow)
        Else
            Set delRng = Union(delRng, wsImport.Rows(lRow))
        End If
    End If
Next

If Not delRng Is Nothing Then delRng.Delete

Using CountIf (Untested)

Dim delRng As Range

For lrow = 1 To numRowsInBBS
    If Application.WorksheetFunction.CountIf(ws.Range("AE4:AE" & numRows), lrow) > 0 Then
        If delRng Is Nothing Then
            Set delRng = wsImport.Rows(lrow)
        Else
            Set delRng = Union(delRng, wsImport.Rows(lrow))
        End If
    End If
Next

If Not delRng Is Nothing Then delRng.Delete

Upvotes: 2

Related Questions