Hi I am looking for some help on this in macro I have over 185000 rows and I ran this code it took over hour to run.
Do you a faster code that can accomplish the same as this one in less time?
Any help is greatly appreciated

Sub ClearDupOnD()
Dim StartRow As Long
Dim EndRow As Long
Dim R As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
StartRow = 1
EndRow = Cells(StartRow, "B").End(xlDown).Row
For R = EndRow To StartRow Step -1
If Application.CountIf(Range(Cells(1, "D"), _
Cells(R, "D")), Cells(R, "D").Value) > 1 Then
Range("D" & R).ClearContents
End If
Next R
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub