How to delete rows faster? - excel

Question

I have this sub to delete a row when certain criteria is met. However, I find it taking way too much time to run. Is there any way I could make this run any faster?
'This sub deletes the row that has any of the following values
Dim ws As Worksheet, i&, lastrow&, value$
Set ws = ActiveWorkbook.Sheets("Product Qty")
lastrow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = lastrow To 2 Step -1
value = ws.Cells(i, 2).value
' Check if it contains one of the keywords.
If (value Like "*VOI*" _
Or value Like "*SLOC*" _
Or value Like "*NCM*" _
Or value Like "*RTS*" _
Or value Like "*VND*" _
Or value Like "*DFFC*" _
Or value Like "*STOR*") _
Then
' Protected values found. Delete the row.
ws.Rows(i).delete
End If
Next
Application.ScreenUpdating = True

Answer 1

Two things that make your code faster:
Read your data into an array and loop through that array instead of a range. Looping through arrays is faster than looping through ranges.
Collect all the rows you want to delete in a range variable RowsToDelete using the Application.Union method and delete them all at once in the end.
Note that I recommend not to use Value as a variable name as this could easily confuse with the .Value property of a range.
Option Explicit
Sub DeleteRows()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Product Qty")
Dim LastRow As Long
LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
'read data into array
DataArr() As Variant
DataArr = ws.Range("B1", "B" & LastRow).value
Dim ChkVal As String
'we collect all rows in a range using union
Dim RowsToDelete As Range
Dim iRow As Long
For iRow = 2 To UBound(DataArr, 1)
ChkVal = DataArr(iRow, 1)
' Check if it contains one of the keywords.
If (ChkVal Like "*VOI*" _
Or ChkVal Like "*SLOC*" _
Or ChkVal Like "*NCM*" _
Or ChkVal Like "*RTS*" _
Or ChkVal Like "*VND*" _
Or ChkVal Like "*DFFC*" _
Or ChkVal Like "*STOR*") Then
' Protected values found.
If RowsToDelete Is Nothing Then 'first row
Set RowsToDelete = ws.Rows(iRow)
Else 'all following rows
Set RowsToDelete = Union(RowsToDelete, ws.Rows(iRow))
End If
End If
Next
'delete all rows
If Not RowsToDelete Is Nothing Then RowsToDelete.Delete
End Sub

Answer 2

If you need multiple wildcard criteria, you can do it by an autofilter also:
put filter criteria in a range (on a separate sheet)
use the range for an autofilter
delete all rows
The criteria-rows are OR-combined and can be placed anywhere on a different worksheet:
By following, above critera defines all rows to be deleted:
Private Sub DeleteRowsFast()
Dim ws As Worksheet, fs As Worksheet
Set ws = ActiveSheet
Set fs = Sheets("FilterSheet")
ws.UsedRange.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=fs.Range("Filter1"), _
Unique:=False
ws.Rows("2:1000000").Delete Shift:=xlUp ' delete visible rows
ws.ShowAllData
End Sub