excelvbaperformanceautofilter

How to delete the filtered rows by the fastest method?


I have a dataset of 30k rows and 15 column.
I have set autofilter on column "O" to select the cells contains string "x" and delete all these rows.
the code takes a lot of time to finish (about 14 seconds) on a very power PC.
Is my code formulated well or there is a faster method to delete these filtered rows?
In advance, grateful for any helpful comments and answers.

Sub Macro1()

   Dim ws As Worksheet, rng As Range, lastR As Long, lastC As Long
   
   Set ws = ActiveSheet
    lastR = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row                      'Last Row on column 1
     lastC = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column             'Last Column on Row 1
     
    Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastR, lastC))

    ws.Rows("1:1").AutoFilter
    rng.AutoFilter Field:=15, Criteria1:="x"
    
    Intersect(ws.Cells, rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow).Delete
    
End Sub 

Solution

  • As Joe said, sorting the data may help. I'd like to add that turning ScreenUpdating and automatic calculation off may significantly reduce the execution time (don't forget to turn them on at the end of the code). Also, using arrays is much-much faster than working with worksheets directly. Though, attention must be paid whether the data are static (i.e., don't depend on the rest of the data that might be changed).

    I wrote a simple piece of code to test how faster (or slower) will it be to work with arrays.

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim sh As Worksheet
    Dim rng As Range
    Dim n_rows As Long
    Dim n_cols As Integer
    Dim r_pointer As Long
    Dim arr_in() As Variant
    Dim arr_out() As Variant
    Dim r As Long
    Dim c As Integer
    
    Const idx_init As Integer = 1
    Const c_target As Integer = 15
    Const s_cmp As String = "x"
    
    n_rows = 30000
    n_cols = 15
    
    Set sh = Sheet1
    Set rng = sh.Range("A1").Resize(n_rows, n_cols)
    
    ReDim arr_in(idx_init To n_rows, idx_init To n_cols)
    ReDim arr_out(idx_init To n_rows, idx_init To n_cols)
    
    arr_in = rng.Value
    r_pointer = 0
    For r = n_rows To idx_init Step -1
      ' Adapt to case comparison mode required.
      If arr_in(r, c_target) <> x_cmp Then
        r_pointer = r_pointer + 1
        For c = idx_init To n_cols
          arr_out(r_pointer, c) = arr_in(r, c)
        Next c
      End If
    Next r
    rng.Value = arr_out
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    

    Your code took 1.58 sec.

    Your code with ScreenUpdating and automatic calculation off took 1.63 sec.

    My code took 0.46 sec.