Sub DeleteDupeRows()
Dim rCrit As Range
Dim LastRow As Long
Const DupesCol As String = "I" '<- Column that your numbers of interest are in
Application.ScreenUpdating = False
LastRow = Range(DupesCol & Rows.Count).End(xlUp).Row
Set rCrit = Range("ZZ1:ZZ2")
rCrit.Cells(2).Formula = Replace("=COUNTIF(#$2:#$" & LastRow & ",#2)>1", "#", DupesCol)
With Range(Replace("#1:#" & LastRow, "#", DupesCol))
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
.Offset(1).SpecialCells(xlVisible).EntireRow.Delete
End With
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
rCrit.ClearContents
Application.ScreenUpdating = True
End Sub