I have a bit of code that deletes rows that do not match a certain criteria:

For i = Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
If Cells(i, "D").Value < Range("D2").Value Then
Rows(i).Delete
End If
Next i

This works but it takes forever, sometimes has to delete 1500 rows.

I am looking for something that will identify the first row in Col D that
does not match D2 and then offsets to the same row in Col A where I will use
the following:

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

Any Suggestions?