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

Find and Delete Duplicates

If you wanted to delete the duplicate values in a list then the following will located the duplicate values with a formula and then place it in the column next to the one you are checking - in the following case data is in column A. Then it will delete the entire row and clear the formula which was created to identify duplications.

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

Using the Dictionary to Find Duplicates

Let's take this concept one step further and use a slightly different method. The scripting dictionary works perfectly to remove duplicates as just alike a regular dictionary - no duplicate descriptions are present. No two words spelt the same are in the dictionary so it can identify a unique number or text string and let it inside the dictionary. A second instance will not be allowed in, meaning no duplication is allowed.  

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.