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
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
.