Deleting Duplicates
 

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

--
halem
-----------------------------------------------------------------------
halem2's Profile: http://www.excelforum.com/member.php...nfo&userid=993
View this thread: http://www.excelforum.com/showthread.php?threadid=27059

Deleting Duplicates
 

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


"halem2" wrote in message
...

Hi:

I'm trying to adapt a vb code I found on the web
(http://www.ozgrid.com/VBA/VBACode.htm) to work for me. I need to go
thru column A evaluating each cell against the rest to the cells in
that colum. If I find a duplicate, then delete the entire row. The
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.


--
halem2
------------------------------------------------------------------------
halem2's Profile:
http://www.excelforum.com/member.php...fo&userid=9930
View this thread: http://www.excelforum.com/showthread...hreadid=270599