Currently I'm using the following function to count unique combinations in 2 columns and that works fine. But how can I adapt this function to count duplicate combinations instead of unique combinations?
Function UniqueCount(searchFor As Variant, searchColumn As Range, countUnique As Range) As Variant
Dim noDupes As New Collection
Dim c As Range, myCount As Long
Dim strSearch As String, strFound As String
On Error Resume Next
'if user entered a range, read its value otherwise, accept it as a string
Set c = Application.Intersect(searchFor, searchFor.Parent.Cells)
If Err Or c Is Nothing Then
Err.Clear
strSearch = searchFor
Else
strSearch = searchFor.Cells(1).Value
End If
'check the column references
On Error GoTo referenceError
If searchColumn.Cells.Count <> countUnique.Cells.Count Then
'the search range and count range do not match
GoTo referenceError
End If
'look at each cell in the search column
On Error GoTo unknownError
myCount = 0
For i = 1 To searchColumn.Cells.Count
'does this cell value match what we're looking for?
If searchColumn.Cells(i).Text = strSearch Then
'check the corresponding cell in the count column
On Error Resume Next
strFound = countUnique.Cells(i)
'attempt to add this item to the collection
noDupes.Add strFound, strFound
If Err Then
'it was a duplicate, ignore it
Err.Clear
Else
'it was unique, count it
myCount = myCount + 1
End If
End If
Next i
'return the count of unique items
UniqueCount = noDupes.Count
GoTo leave
referenceError:
'return a reference error
UniqueCount = CVErr(xlErrRef)
unknownError:
'untrapped error; return "#NA"
UniqueCount = CVErr(xlErrNA)
leave:
End Function
Bookmarks