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

Answer 2

I agree with @Tim_Williams that you need to work backwards as that seems to be the issue. I would do something like this.

Sub Main()
Dim workrange As Range
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim lrow As Integer

'Find first and last used row in column D
Range("D:D").Select
Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.Range("D1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row

'Loop through used cells backwards and delete if needed
For lrow = Lastrow To Firstrow Step -1
    Set workrange = Cells(lrow, 4)
    If workrange.Value <> "VFIRE" _
        And workrange.Value <> "ILBURN" _
        And workrange.Value <> "SMOKEA" _
        And workrange.Value <> "ST3" _
        And workrange.Value <> "TA1PED" _
        And workrange.Value <> "UN1" _
            Then workrange.EntireRow.Delete

Next lrow

End Sub

Answer 3

I used this in one of my task, where as I had array of test data of 100 iteration, which I want to trim to first 10 iteration, so I used the "iteration# > 10" cells to delete entire row.

Sub trim_row()

' trim_row Macro
' to trim row which is greater than iteration#10

Dim RowToTest As Long
Dim temp As String
Dim temp1 As Integer

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

With Cells(RowToTest, 6)

temp = .Value
If temp = "" Then

    Else
    temp1 = Trim(Replace(temp, "Iteration# :: ", ""))

        If temp1 > 10 Then
        Rows(RowToTest).EntireRow.Delete
        End If
End If

End With

Next RowToTest

End Sub

I user replace & trip to extract number from the string, and introduced the if = "" condition to skip the empty rows. I had empty row separating to set of test data.