Deleting Duplicates

[halem2]

Hi:

I'm trying to adapt a vb code I found on the we
(http://www.ozgrid.com/VBA/VBACode.htm) to work for me. I need to g
thru column A evaluating each cell against the rest to the cells i
that colum. If I find a duplicate, then delete the entire row. Th
objective is to leave only one of each in the colum.

This is what I have so far:

Sub DelDupsONEList()
Dim iListCount As Integer
Dim iCtr As Integer
'
Application.ScreenUpdating = False
'
iListCount = ActiveSheet.Range("A1:A1000").Rows.Count
For Each x In ActiveSheet.Range("A1:A1000")
For iCtr = 1 To iListCount
If x.Value = ActiveSheet.Cells(iCtr, 1).Value Then
ActiveSheet.Cells(iCtr, 1).EntireRow.Delete
iCtr = iCtr + 1
End If
Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub


I'm getting an error on:
If x.Value = ActiveSheet.Cells(iCtr, 1).Value Then...

ANy help would be greatly appreciated

 

[Trevor Shuttleworth]

One way:

Sub DeleteDuplicates()
Dim LastRow As Long
Dim i As Long
Application.ScreenUpdating = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 1 Step -1
If WorksheetFunction.CountIf(Range("A:A"), Range("A" & i)) > 1 Then
Range("A" & i).EntireRow.Delete
End If
Next 'i
Application.ScreenUpdating = True
End Sub

Regards

Trevor