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

On Oct 8, 10:51*am, "J.W. Aldridge" <jeremy.w.aldri...@gmail.com>
wrote:
> 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")