Remove duplicate items from a worksheet range

 2012-02-08    Worksheets    3    235

According to the Excel Developer Reference for Office 2007 documentation, or well hidden in the built-in the VBA help file, you should be able to delete duplicate entries from a worksheet range using the RemoveDuplicates method like this:

ActiveSheet.Range("A1:F100").RemoveDuplicates
This method is new in Excel 2007 and will not work in older Excel versions. It takes 2 optional arguments (columns and headers) and should work without any of them, but this seems not to be true. If you use the method and pass values for the 2 arguments it works like intended. Both of the example lines below works just fine:
ActiveSheet.Range("A1:F100").RemoveDuplicates Columns:=Array(1,2,3,4,5,6), Header:=xlYes
ActiveSheet.Range("A1:F100").RemoveDuplicates Array(1,2,3,4,5,6), xlYes
The problem is that sometimes you don't know exactly how many columns you want to check duplicates in, e.g. when you write a procedure for removing duplicates from a worksheet where the number of columns with data may vary from time to time. Then you need to replace Array(1,2,3,4,5,6) in the example above with a variable that contains a similar zero-based Variant array where the upper bound value is one less than the number of columns you want to check for duplicates, e.g. like this:
Dim varItems(0 to 2) As Variant ' 3 columns
Dim varItems(0 to 5) As Variant ' 6 columns
Below is a procedure example that can be used for removing duplicates from any sized range:
Sub RemoveDuplicatesFromRange(objRange As Range, _
    Optional varColumns As Variant = False, _
    Optional blnHasHeader As Boolean = True)
' varColumns should be an array containing column numbers
Dim lngCount As Long, i As Long, j As Long, varItems() As Variant
    If objRange Is Nothing Then Exit Sub
    With objRange
        If Not IsArray(varColumns) Then ' check all columns in the range
            ReDim varItems(0 To .Columns.Count - 1)
            For i = 1 To .Columns.Count
                varItems(i - 1) = i
            Next i
        Else
            ReDim varItems(0 To UBound(varColumns) - LBound(varColumns) - 1) ' must be a 0-based variant array
            j = -1
            For i = LBound(varColumns) To UBound(varColumns)
                j = j + 1
                varItems(j) = varColumns(i)
            Next i
        End If
        On Error GoTo FailedToRemoveDuplicates
        If blnHasHeader Then
            .RemoveDuplicates varItems, xlYes
        Else
            .RemoveDuplicates varItems, xlNo
        End If
        On Error GoTo 0
    End With
    Exit Sub
    
FailedToRemoveDuplicates:
    If Application.DisplayAlerts Then
        MsgBox Err.Description, vbInformation, "Error Removing Duplicates From Range: " & objRange.Address
    End If
    Resume Next
End Sub
And below you will find a few examples on how to use the procedure above:
Sub TestRemoveDuplicatesFromRange1()
    RemoveDuplicatesFromRange Range("A1").CurrentRegion ' checks all columns
End Sub

Sub TestRemoveDuplicatesFromRange2()
    RemoveDuplicatesFromRange Range("A1").CurrentRegion, Array(1, 3, 5) ' checks columns 1, 3 and 5
End Sub

Sub TestRemoveDuplicatesFromRange3()
Dim varItems(0 To 2) As Variant ' must be 0-based variant array
    varItems(0) = 1
    varItems(1) = 3
    varItems(2) = 5
    RemoveDuplicatesFromRange Range("A1").CurrentRegion, varItems ' checks columns 1, 3 and 5
End Sub

Sub TestRemoveDuplicatesFromRange4()
Dim lngCount As Long, varItems() As Variant, i As Long, c As Long
    lngCount = Range("A1").CurrentRegion.Columns.Count \ 2
    ReDim varItems(0 To lngCount - 1) ' must be 0-based variant array
    i = 0
    For c = 1 To Range("A1").CurrentRegion.Columns.Count Step 2
        varItems(i) = c
        i = i + 1
    Next c
    RemoveDuplicatesFromRange Range("A1").CurrentRegion, varItems ' checks every odd column
End Sub
It is also possible to manage without the macro RemoveDuplicatesFromRange above by doing something like this:
Sub RemoveDuplicatesFromRangeAlt1()
Dim c As Long, varItems() As Variant ' must be 0-based variant array
    With Range("A1").CurrentRegion
        ReDim varItems(0 To .Columns.Count - 1)
        For c = 1 To .Columns.Count
            varItems(c - 1) = c
        Next c
        .RemoveDuplicates varItems, xlYes ' checks all columns
    End With
End Sub

Sub RemoveDuplicatesFromRangeAlt2()
    Range("A1").CurrentRegion.RemoveDuplicates Array(1, 3, 5), xlYes ' checks columns 1, 3 and 5
End Sub

Sub RemoveDuplicatesFromRangeAlt3()
Dim varItems(0 To 2) As Variant ' must be 0-based variant array
    varItems(0) = 1
    varItems(1) = 3
    varItems(2) = 5
    Range("A1").CurrentRegion.RemoveDuplicates varItems, xlYes ' checks columns 1, 3 and 5
End Sub