Delete Entire Rows Based on Cell Values

Question

I want in Excel (2003) to take an imported data dump and format it into a report. Most of what I have done has involved recording a macro and then customizing the code where needed. I have a spot that requires pure code.

I have a SORTED column (D) that lists types of incidences (for example: vehicle fires, strokes, animal bites, etc). I would like to read each value in column D and if it is NOT one of several values we are looking for, delete the entire row.

I have tried multiple versions of code (that I have found online) and the code that produces the results closest to what I need looks like this:

Range("D:D").Select
Dim workrange As Range
Dim cell As Range
Set workrange = Intersect(Selection, ActiveSheet.UsedRange)
For Each cell In workrange
    If ActiveCell.Value <> "VFIRE" _
        And ActiveCell.Value <> "ILBURN" _
        And ActiveCell.Value <> "SMOKEA" _
        And ActiveCell.Value <> "ST3" _
        And ActiveCell.Value <> "TA1PED" _
        And ActiveCell.Value <> "UN1" _
            Then ActiveCell.EntireRow.Delete
Next cell
End Sub

This code deletes a majority of the list (~100 rows of the original 168), but it is only deleting the rows until it hits the first value of something I want. For example, this current data dump does not have any values for "ILBURN" or "SMOKEA", but when the first occurrence of "ST3" occurs the macro stops. There is no error generated, it just seems to think it is done.

What should I add to invoke the macro through the entire list?

Answer 1

I'm all about brevity.

Sub DeleteRowBasedOnCriteria()
Dim RowToTest As Long

For RowToTest = Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1

With Cells(RowToTest, 4)
    If .Value <> "VFIRE" _
    And .Value <> "ILBURN" _
    And .Value <> "SMOKEA" _
    And .Value <> "ST3" _
    And .Value <> "TA1PED" _
    And .Value <> "UN1" _
    Then _
    Rows(RowToTest).EntireRow.Delete
End With

Next RowToTest

End Sub