VBA : How to Remove Duplicates in Excel

This tutorial explains multiple ways to remove duplicates in Excel using VBA code.

You can download the following dataset to practice.

  Download Excel File

It scans the specified range and removes duplicate values that exist in the specified range.

Let’s take the sample data and remove duplicates from column A. Follow the code given below:

Sub RemoveDuplicates1()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    Set ws = ThisWorkbook.ActiveSheet
    
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
    
    ws.Range("A1:A" & lastRow).RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

Press Run or F5 to run the above code.

In this example we are trying to remove the rows that have the same entries in columns A, B and C. The following code should be executed:

Sub removeduplicate2()
    Dim rng As Range
    Dim ws As Worksheet
    Dim lastRow As Long

    Set ws = ThisWorkbook.ActiveSheet
    
   lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    Set rng = ws.Range("A1:D" & lastRow)
     
    rng.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End Sub

Press Run or F5 to run the above code.

Let’s delete the rows in the entire range that have the same entries in the corresponding columns.

Sub removeduplicate3()
    Dim rng As Range
    Dim ws As Worksheet
    Dim lastRow As Long
    
    Set ws = ThisWorkbook.ActiveSheet
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
      Set rng = ws.Range("A1:D" & lastRow)
    
      rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
End Sub

Press Run or F5 to run the above code.

Advanced Filter remove duplicates by copying the unique values to another location.

dataRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("F1"), Unique:=True extracts unique values from the specified range and copies to column F.

The following code extracts unique values from column A and paste to column F.

Sub UsingAdvFilter1()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim copyRange As Range
    
    Set ws = ThisWorkbook.ActiveSheet
    
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row

    Set dataRange = ws.Range("A1:A" & lastRow)
    
    ws.Range("F1:F" & lastRow).Clear
    
    dataRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ws.Range("F1"), Unique:=True
End Sub

Press Run or F5 to run the above code.

In this case we are trying to extract unique values from multiple Columns A and B. The following code should be executed:

Sub UsingAdvFilter2()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim copyRange As Range
    
    Set ws = ThisWorkbook.ActiveSheet
    
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row

    Set dataRange = ws.Range("A1:B" & lastRow)
    
    ws.Range("F1:F" & lastRow).Clear
    
    dataRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ws.Range("F1"), Unique:=True
End Sub

Press Run or F5 to run the above code.

In this case we are trying to extract unique values from the entire range. The following code should be executed:

Sub UsingAdvFilter3()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim copyRange As Range
    
    Set ws = ThisWorkbook.ActiveSheet
    
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row

    Set dataRange = ws.Range("A1:D" & lastRow)
    
    ws.Range("F1:F" & lastRow).Clear
    
    dataRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ws.Range("F1"), Unique:=True
End Sub

Press Run or F5 to run the above code.

Read MoreListenData