Deleting Duplicates

L

LarryP

To add to Andy's answer: Put in a "helper column" as he
suggests, then use the following macro to identify any
duplicates. If you select the first item in the "helper
column" and then launch the macro, it'll put in a new
blank column, then fill in that column with
either "UNIQUE" for the first occurrence of a value
or "DUPLICATE" for any subsequent occurrences.
(If you create this macro in your Personal.xls file it'll
be available to you in ANY spreadsheet -- I use it all the
time.)

******************************************************
Sub Duplicates()
Dim strValArray() As String
Dim lngCounter As Long

Selection.EntireColumn.Insert
ReDim strValArray(0)
strValArray(0) = ActiveCell.Offset(0, 1).Value
ActiveCell.Value = "Unique"
lngCounter = 1
Do While ActiveCell.Offset(1, 1).Value > ""
ActiveCell.Offset(1, 0).Select
'FindDups
Dim x As Long
x = 0
Do Until ActiveCell.Value = "Duplicate" Or x =
UBound(strValArray) + 1
If strValArray(x) = ActiveCell.Offset(0,
1).Value Then
ActiveCell.Value = "Duplicate"
Else
x = x + 1
End If
Loop


If ActiveCell.Value <> "Duplicate" Then
ReDim Preserve strValArray(UBound(strValArray)
+ 1)
strValArray(UBound(strValArray)) =
ActiveCell.Offset(0, 1).Value
ActiveCell.Value = "Unique"
End If
lngCounter = lngCounter + 1
Loop
MsgBox ("Items checked = " & lngCounter & ", Unique
Count = " &
UBound(strValArray) + 1)
End Sub

*******************************************************
 
Top