Code deletes first row/headers.

[J.W. Aldridge]

Code works, but keeps deleting the headers in row 1. How to avoid/fix
please?

Sub Delete_ROUTES_ColE()

Application.ScreenUpdating = False

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long

With ActiveSheet

'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(2).Row 'The 1 represents the
RowIndex
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

'Loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1

'Check the values in the D column
With .Cells(Lrow, "E")


If .Value <> "APPLES" And .Value <> "GRAPES" And .Value <>
"PLUMS" And .Value <> "DATES" And .Value <> "PEARS"
Then .EntireRow.Delete

End With
Next Lrow

End With

Application.ScreenUpdating = True

End Sub

 

[Don Guillett Excel MVP]

Code works, but keeps deleting the headers in row 1. How to avoid/fix
please?

Sub Delete_ROUTES_ColE()

Application.ScreenUpdating = False

        Dim Firstrow As Long
        Dim Lastrow As Long
        Dim Lrow As Long

        With ActiveSheet

        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(2).Row 'The 1 represents the
RowIndex
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'Loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1

        'Check the values in the D column
        With .Cells(Lrow, "E")

            If .Value <> "APPLES" And .Value <> "GRAPES" And ..Value <>
"PLUMS" And .Value <> "DATES" And .Value <> "PEARS"
Then .EntireRow.Delete

        End With
        Next Lrow

    End With

Application.ScreenUpdating = True

End Sub

I would have done it differently but instead of cells(2), use
cells(2,1) or range("a2")