Sub Delete_Rows()
Dim lr As Long, i As Long, a, r As Range, dict As Object
Application.ScreenUpdating = False
lr = Range("A" & Rows.Count).End(xlUp).Row
Set r = Range("A" & lr + 1)
Set dict = CreateObject("scripting.dictionary")
a = Range("F2:F" & lr)
For i = 1 To UBound(a)
If Not dict.exists(a(i, 1)) Then
dict(a(i, 1)) = dict(a(i, 1))
Else
Set r = Union(r, Range("A" & i + 1))
End If
Next i
r.EntireRow.Delete
End Sub