Detecting / Counting Duplicate Items in a ListBox

This code sample shows how to detect and count the duplicate entries in a ListBox, it could also be adapted to be used with a ComboBox control.

The code makes use of the SendMessage API along with the ListBox LB_FINDSTRINGEXACT windows message to detect duplicate items. If you were changing the code to work with a combo, you would use the CB_FINDSTRINGEXACT message instead.

private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(byval hwnd as Long, byval wMsg as Long, _
byval wParam as Long, lParam as Any) as Long
private Const LB_FINDSTRINGEXACT = &H1A2
private Sub Command1_Click()
Dim iIndex as Long
Dim iMatch as Long
Dim iCopies as Long
Dim iHighest as Long
Dim aCommon() as Long
Dim sString asstring
Dim bSkip as Boolean
for iIndex = 0 to List1.ListCount - 1
iCopies = 0
iMatch = -1
bSkip = false'Skip this one if it's the same as the last Item Checked
If iIndex then
bSkip = (List1.List(iIndex) = List1.List(iIndex - 1))
End If
'Skip this one if there's a previous instance of it in the List
If Not bSkip then
bSkip = (SendMessage(List1.hwnd, LB_FINDSTRINGEXACT, -1, _
byval List1.List(iIndex)) < iIndex)
End If
'While there are other Instances in the List..
While iMatch <> iIndex And Not bSkip
'Increment the No of Copies Found of this Item
iCopies = iCopies + 1
'Find the next Copy..
iMatch = SendMessage(List1.hwnd, LB_FINDSTRINGEXACT, _
IIf(iMatch < 0, iIndex, iMatch), _
byval List1.List(iIndex))
Wend
'If there were more than 1 Copies
If iCopies > 1 And Not bSkip then'If the No. of Copies is Greater or the Same as the Highest so far..
If iCopies >= iHighest then
If iCopies > iHighest then'new Highest Copies
ReDim aCommon(0)
else'Another Item with the same highest amount of Copies
ReDim Preserve aCommon(UBound(aCommon) + 1)
End If
'Store this Index
aCommon(UBound(aCommon)) = iIndex
'Remember the Highest No. of Copies
iHighest = iCopies
End If
End If
next
If iHighest then'If Copies were Found..for iIndex = 0 to UBound(aCommon)
sString = sString & ", " & List1.List(aCommon(iIndex))
next
MsgBox "Most Repeated Item(s): " & vbCrLf & mid$(sString, 3) & _
vbCrLf & vbCrLf & "Repeated " & iHighest & " Times.", _
vbInformation + vbOKOnly, "Repeats"
else'No Copies Found..
MsgBox "No Items were Repeated", vbInformation + vbOKOnly, _
"No Repeats"
End If
End Sub
''