Improving For Loop Efficiency VBA

Question

Currently I have 10Kx15 Rows worth of raw data imported in an excel spreadsheet. I have a number of fields that are cleansed but the one of interest is a field called "Hazard". For every instance of Hazard encountered, we need to strip this out.

This is the code I use to cleanse (partially) my data set:

Sub dataCleanse()
Dim Last

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Last = Cells(Rows.Count, "F").End(xlUp).Row
For i = Last To 1 Step -1
    If (Cells(i, "F").Value) = "Hazard" Then
        Cells(i, "A").EntireRow.Delete
    End If
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

To process 10,000 records or so it takes 10-15 seconds. I have experimented with using auto-filter, but when I use .EntireRow.Delete it strips out the rows underneath the filtered criteria. i.e. If we have rows 1 and 3 with 'Hazard' and use auto-filter, it will also delete row2 which does not have 'Hazard'.

I have also set the calculation to Manual first and then Automatic so it doesn't refresh each time.

Are there any suggestions that could be offered to increase the speed of my macro?

Thank you!

Answer 1

you could go with the following Autofilter approach

Option Explicit

Sub dataCleanse()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

With ActiveSheet
    ' insert "dummy" header cell for Autofilter to work
    .Range("F1").Insert
    .Range("F1").value = "header"

    With .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
        .AutoFilter Field:=1, Criteria1:="Hazard"
        With .Offset(1).Resize(.Rows.Count - 1)
            If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        .AutoFilter
    End With

    .Range("F1").Delete 'remove "dummy" header cell

End With

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

processing 10,000 records of 250 columns each in much less then a second