I have a macro that will remove duplicates from a sorted list (see below), however a simpler option may be to create a pivot table.
Simply highlight your column of data containing duplicates then create a pivot table using that column as a Row and Data field.
The resulting table will list unique entries from your column along with a count of how many of each there are.
REMOVE DUPLICATES MACRO (NB: This was written some time ago and may not be the most efficient way of doing this!!)
Sub Replace_Duplicate_Records()
'NB: Records MUST be sorted before running this macro so that all "like" entries
'are grouped together. You must also select the range from which you want to
'remove duplicates BEFORE running the macro. The range must be ONE column wide
'and AT LEAST 2 rows deep.
'Display warning that data must be sorted prior to running the macro
'and give user option to exit if they have not sorted data
Msg = "Data must be sorted in order for this macro to work." & Chr(10) & Chr(10) _
& "Is the data sorted?"
Ans = MsgBox(Msg, vbQuestion + vbYesNo)
Select Case Ans
Case vbYes
GoTo continue_macro
Case vbNo
MsgBox "Sort the data before running the macro.", vbInformation, "Note:"
Exit Sub
End Select
continue_macro:
'begin declarations
Dim number_rows, number_cols
number_rows = Selection.Rows.Count
number_cols = Selection.Columns.Count
Dim RowNdx As Long
Dim ColNum As Integer
ColNum = Selection(1).Column
'end declarations
If number_cols > 1 Then
MsgBox "Select a single column of data to work on.", vbInformation, "Error"
Exit Sub
End If
If number_rows < 2 Then
MsgBox "Select more than one row of data.", vbInformation, "Error"
Exit Sub
End If
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
Cells(RowNdx, ColNum).Value = "-----"
End If
Next RowNdx
'
'Search and Delete all instances of "-----"
For Each Cell In Selection
If Cell.Value = "-----" Then
On Error GoTo ErrorHandler
Set ToDelete = Application.Union(ToDelete, Cell.EntireRow)
End If
Next
On Error GoTo EndIt
ToDelete.Delete
ErrorHandler:
Set ToDelete = Cell.EntireRow
Resume Next
EndIt:
Exit Sub
End Sub
Hi,j ross. Simply, you can use "AdvancedFilter".
Please click link below.
Return unique items
http://www.erlandsendata.no/english/functions/lookup/uniqueitems.htm