How can I eliminate duplicate data in a column?


Posted by Bill W on August 03, 1999 8:38 AM

I want to select data from a column which is unique, i.e., eliminate any duplicates.

Posted by Harold Ek on August 10, 1999 4:55 PM

I have a reference that addresses your problem.
In very brief terms one of the keys is to first
sort the column of data then use a Do .. Loop and
compare each cell to the next cell, if Equal then
delete row. I was able to copy it completely
so here it is.

Sub BuggyRemoveDuplicates() ' DON'T USE THIS CODE!
Worksheets("Sheet1").Range("A1").Sort _
key1:=Worksheets("Sheet1").Range("A1")
Set r = Worksheets("Sheet1").Range("A1").CurrentRegion.Columns("A")
For Each c In r.Cells
If c.Offset(1, 0).Value = c.Value Then
c.Offset(1, 0).EntireRow.Delete
End If
Next c
End Sub

Good Luck!



Posted by Harold Ek on August 10, 1999 4:59 PM

I have a reference that addresses your problem.
In very brief terms one of the keys is to first
sort the column of data then use a Do .. Loop and
compare each cell to the next cell, if Equal then
delete row. I was able to copy it completely
so here it is.
Naturally I copied the wrong one first, HERE IS THE GOOD ONE!

A better solution is to use a Do...Loop structure, as shown in the following example.
Sub GoodRemoveDuplicates()
Worksheets("Sheet1").Range("A1").Sort _
key1:=Worksheets("Sheet1").Range("A1")
Set currentCell = Worksheets("Sheet1").Range("A1")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
currentCell.EntireRow.Delete
End If
Set currentCell = nextCell
Loop
End Sub



Good Luck!