Sub MyDeleteDups()
Dim lr As Long
Dim r As Long
Application.ScreenUpdating = False
' Find last row with data in column A
lr = Cells(Rows.Count, "A").End(xlUp).Row
' Sort results by columns E, F then A
Range("A1:F" & lr).Sort _
key1:=Range("E1"), order1:=xlAscending, _
key2:=Range("F1"), order2:=xlAscending, _
key3:=Range("A1"), order3:=xlAscending, Header:=xlYes
' Loop through rows backwards, comparing each row to the row above it
For r = lr To 3 Step -1
' Check to see if columns E and F match and the difference in A is less than 4 hours
If (Cells(r, "E") = Cells(r - 1, "E")) And (Cells(r, "F") = Cells(r - 1, "F")) And _
(Cells(r, "A") - Cells(r - 1, "A") < (4 / 24)) Then
Rows(r).Delete
End If
Next r
Application.ScreenUpdating = True
MsgBox "Macro complete!"
End Sub