Delete Entire Row for duplicate values in selected column

[porter444]

I work with massive lists of data everyday, and many times have to combine
multiple sheets. This of course leads to duplicates, and hence having to
delete the duplicates. Today I use countif if to identify them, sort and
delete.

This works fine, but I keep thinking there has to be a better way.

What I'd really like to have is a macro that, for the column I select, rows
with duplicate values are deleted. If no duplicates are found, a message box
that says that. Would like to keep the first value found.

Thanks in advance!

Scott

 

[dbKemp]

I work with massive lists of data everyday, and many times have to combine
multiple sheets. This of course leads to duplicates, and hence having to
delete the duplicates. Today I use countif if to identify them, sort and
delete.

This works fine, but I keep thinking there has to be a better way.

What I'd really like to have is a macro that, for the column I select, rows
with duplicate values are deleted. If no duplicates are found, a message box
that says that. Would like to keep the first value found.

Thanks in advance!

Scott

I use this. You could also use the Scripting.Dictionary object if
this is too slow.


Private Sub RemoveDupeRecords(ByRef Target As Range, ByVal RefCol As
Integer)
' Purpose:
' Deletes entire row of data when reference value is duplicated.
'
' Inputs:
' [Target] In/Out - Range representing database
' [RefCol] In - Column to be used to determine duplicate records
'
' Remarks:
' Attempts to put value of each cell in RefCol into a collection
' If there is a duplicate an error occurs and ErrorHandler deletes
' entire row of associated cell.

Dim iCounter As Integer
Dim sValue As String 'data in rCell, used for dupe check
Dim colUniqueTerms As Collection
Dim rCell As Range 'current cell

Set colUniqueTerms = New Collection
On Error GoTo ErrorHandler
For iCounter = Target.Rows.Count To 2 Step -1
Set rCell = Target.Cells(iCounter, RefCol)
sValue = rCell.Value
colUniqueTerms.Add sValue, sValue
Next
On Error GoTo 0

Set colUniqueTerms = Nothing
Set rCell = Nothing
Exit Sub
ErrorHandler:
rCell.EntireRow.Delete
Resume Next
End Sub

 

[porter444]

THANKS!