Sub Del_Dupes()
Dim d As Object
Dim a, b
Dim nc As Long, i As Long, k As Long
Dim s As String
nc = Cells(1, Columns.Count).End(xlToLeft).Column + 1
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = 1
a = Range("A2", Range("F" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
s = Join(Application.Index(a, i, 0), "|")
If d.exists(s) Then
b(i, 1) = 1
k = k + 1
Else
d(s) = 1
End If
Next i
If k > 0 Then
Application.ScreenUpdating = False
With Range("A2").Resize(UBound(a), nc)
.Columns(nc).Value = b
.Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.Resize(k).EntireRow.Delete
End With
Application.ScreenUpdating = True
End If
End Sub