Remove duplicate items from a worksheet range
2012-02-08 Worksheets 3 5479
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 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 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