How to Find Duplicates in a Column Using Excel VBA (5 Ways)

Method 1 – Find Duplicates for Range of Cells in a Column

❶ Press ALT + F11 to open the VBA editor.

❷ Go to Insert >> Module.

Insert a new module to Find Duplicates in a Column Using Excel VBA

❸ Copy the following VBA code.

Sub FindDuplicateValues()

Dim xWs As Worksheet

Set xWs = Worksheets("VBA1")

For m = 5 To 12
If Application.WorksheetFunction.CountIf(xWs.Range("B5:B12"), xWs.Range("B" & m)) > 1 Then
xWs.Range("C" & m).Value = True
Else
xWs.Range("C" & m).Value = False
End If
Next m

End Sub

❹ Paste and Save the code in the VBA editor.

❺ Open the Excel worksheet and press ALT + F8 to open the Macro dialog box.

❻ Select the macro FindDuplicateValues and hit the Run button.

Results will show TRUE for the duplicate values and FALSE for the unique values in their adjacent cells.

Method 2 – Select a Range and Highlight Duplicates in a Column Using Excel VBA

❶ Press ALT + F11 to open the VBA editor.

❷ Go to Insert >> Module.

Insert a new module to Find Duplicates in a Column Using Excel VBA

❸ Copy the following VBA code.

Sub SelectAndDetectDups()

Dim xRng1 As Range
Dim xCell1 As Range

Set xRng1 = Selection

For Each xCell1 In xRng1
If WorksheetFunction.CountIf(xRng1, xCell1.Value) > 1 Then
xCell1.Interior.ColorIndex = 3
End If
Next

End Sub

❹ Paste and Save the code in the VBA editor.

❺ Open the Excel worksheet and select a range.

❻ Press ALT + F8 to open the Macro dialog box.

❼ Select the macro SelectAndDetectDups and hit the Run button.

Results will show all the duplicate values are highlighted in the selected area.

Method 3 – Detect and Highlight New Entry Duplicates in a Column

❶ Press ALT + F11 to open the VBA editor.

❷ Go to Insert >> Module.

Insert a new module to Find Duplicates in a Column Using Excel VBA

❸ Double-click on a worksheet to insert the VBA code from the Microsoft Excel Objects list.

A Sheet editor will appear.

Select Worksheet from the General.

Expand the Declarations drop-down to select Change.

❹ Copy the following VBA code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 2 Then Exit Sub

On Error GoTo ErrHandler
Application.ScreenUpdating = False

Dim xRng1 As Range
Dim xRng2 As Range

Set xRng1 = Range("B5:B" & Cells(Rows.Count, "B").End(xlUp).Row)

For Each xRng2 In xRng1
xRng2.Offset(0, 0).Font.Color = vbBlack

If Application.Evaluate("COUNTIF(" & xRng1.Address & "," & xRng2.Address & ")") > 1 Then
xRng2.Offset(0, 0).Font.Color = vbRed
End If
Next xRng2

Set xRng1 = Nothing

ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

❺ Paste and Save the code in the VBA editor.

❻ Open the worksheet and insert a new value.

❼ Hit the ENTER button.

Results will show the latest entity is highlighted if it is a duplicate value.

Method 4 – Find and Highlight Duplicates in a Column Using Excel VBA

❶ Press ALT + F11 to open the VBA editor.

❷ Go to Insert >> Module.

Insert a new module to Find Duplicates in a Column Using Excel VBA

❸ Copy the following VBA code.

Option Explicit

Sub HighlightDupsInARange()

Application.ScreenUpdating = False
Range("F5:F" & Cells(Rows.Count, 5).End(xlUp).Row) = "=COUNTIF($C$5:$C5,C5)>1"
Range("F:F").AutoFilter 1, "True"
Range("C4:C" & Cells(Rows.Count, 6).End(xlUp).Row).Interior.Color = vbCyan
Range("F:F").AutoFilter
Range("F:F").ClearContents
Application.ScreenUpdating = True

End Sub

❹ Paste and Save the code in the VBA editor.

❺ Open the Excel worksheet and press ALT + F8 to open the Macro dialog box.

❻ Select the macro HighlightDupsInARange and hit the Run button.

Results will show all the duplicate values highlighted in the insertion range as in the picture below:

Read More: How to Filter Duplicates in Excel

Method 5 – Use VBA to Find and Delete Duplicates in a Column

❶ Press ALT + F11 to open the VBA editor.

❷ Go to Insert >> Module.

Insert a new module to Find Duplicates in a Column Using Excel VBA

❸ Copy the following VBA code.

Sub DeleteDupsInARange()

Application.ScreenUpdating = False
Range("F5:F" & Cells(Rows.Count, 5).End(xlUp).Row) = "=COUNTIF($E$5:$E5,E5)>1"
Range("F:F").AutoFilter 1, "True"
Range("E5:E" & Cells(Rows.Count, 6).End(xlUp).Row).EntireRow.Delete
Range("F:F").AutoFilter
Range("F:F").ClearContents
Application.ScreenUpdating = True

End Sub

❹ Paste and Save the code in the VBA editor.