For Sort BD:

Sub DeleteDuplicateClassic()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

Respect Order:2 s for 10.0000 rows and suppress 5%

Sub RespectOrderDictionary()
Set MonDico = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
i = 2
Do While Cells(i, "A") < ""
If Not MonDico.Exists(Cells(i, "A") & Cells(i, "C")) Then
MonDico.Add Cells(i, "A") & Cells(i, "C"), Cells(i, "A") &
Cells(i, "C")
i = i + 1
Else
Rows(i).EntireRow.Delete
End If
Loop
End Sub

1,17 sec for 10.000 rows and 80% suppress:

Sub DeleteDuplicateQuick()
t = Timer()
Application.ScreenUpdating = False
[A1].Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlGuess
Columns("b:b").Insert Shift:=xlToRight
[B1] = "ColB"
[B2].FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],1,0)"
[B2].AutoFill Destination:=Range("B2:B" & [A65000].End(xlUp).Row)
[B:B].Value = [B:B].Value
[A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlGuess
[B:B].Replace What:="1", Replacement:="", LookAt:=xlPart
Range("B2:B65000").SpecialCells(xlCellTypeBlanks). EntireRow.Delete
Columns("b:b").Delete Shift:=xlToLeft
MsgBox Timer() - t
End Sub

http://cjoint.com/?bvpZzDBano

JB
http://boisgontierjacques.free.fr


On 19 jan, 14:53, David wrote:
Does anyone know a way to delete rows with duplicate data in a document with
over 60,000 rows? *Some data is duplicated as much as 10 times and some as
few as once or not at all.
--
Thanks,
David