Sub test1()
For i = Range("D65535").End(xlUp).Row To 1 Step -1
If Range("D" & i).Value > "" Then
If Application.WorksheetFunction.CountIf(Range("D1:D" & Range("D65535").End(xlUp).Row), _
Range("D" & i).Value) > 1 Then Range("D" & i).EntireRow.Delete
End If
Next
End Sub