Find Duplicates with Excel VBA

When working with lists in Excel you often required to isolate duplication of information.  To find all of the duplicate data in a list you can either use formula which is contained in Find Duplicates in List or you can use VBA.  The following procedure will find all of the duplicated entries in Column A and will highlight them.

Option Explicit

Sub HighlightDups() 'Excel VBA find duplicates with formula (with dynamic range).
Range("B10:B" & Cells(Rows.Count, 1).End(xlUp).Row)="=COUNTIF($A$10:$A10,A10)>1"
Range("B:B").AutoFilter 1, "True"
Range("A10:A" & Cells(Rows.Count, 2).End(xlUp).Row).Interior.Color=vbCyan
Range("B:B").AutoFilter Range("B:B").ClearContents
End Sub

If you wanted to Delete the Duplicates then the following.

Sub HighlightDups() 'Excel VBA find duplicates with formula (with dynamic range). Delete range
Range("B10:B" & Cells(Rows.Count, 1).End(xlUp).Row)="=COUNTIF($A$10:$A10,A10)>1"
Range("B:B").AutoFilter 1, "True"
Range("A10:A" & Cells(Rows.Count, 2).End(xlUp).Row).EntireRow.Delete
Range("B:B").AutoFilter Range("B:B").ClearContents
End Sub

Let's take this concept one step further and use a slightly different method.  Let's match the data between Column A of Sheet 1 with Column A of sheet 2 and put all of the matching data in a new sheet.

Option Explicit

Sub UseofDict() 'Excel VBA find duplicates with the scripting dictionary.
Dim ar As Variant
Dim i As Long
Dim j As Long
Dim n As Long

ar=Sheet2.Cells(1).CurrentRegion.Value
With Createobject("Scripting.Dictionary")
.CompareMode=1
For i=2 To UBound(ar, 1)
.Item(ar(i, 1))=Empty
Next
ar=Sheet1.Cells(1).CurrentRegion.Value
n=1
For i=2 To UBound(ar, 1)
If .exists(ar(i, 1)) Then
n=n + 1
For j=1 To UBound(ar, 2)
ar(n, j)=ar(i, j)
Next
End If
Next
End With
Sheets.Add().Cells(1).Resize(n, UBound(ar, 2)).Value=ar
End Sub

Attached is a working Excel example of the above VBA procedure.