Remove duplicate items from a worksheet range
2012-02-08 Worksheets 3 354
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").RemoveDuplicatesThis 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), xlYesThe 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 columnsBelow 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 SubAnd 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 SubIt 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