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 as string
    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
'
'

Download Zipped Project file (5k)

screen-shot



Comments

  • There are no comments yet. Be the first to comment!

Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

  • Java developers know that testing code changes can be a huge pain, and waiting for an application to redeploy after a code fix can take an eternity. Wouldn't it be great if you could see your code changes immediately, fine-tune, debug, explore and deploy code without waiting for ages? In this white paper, find out how that's possible with a Java plugin that drastically changes the way you develop, test and run Java applications. Discover the advantages of this plugin, and the changes you can expect to see …

  • Savvy enterprises are discovering that the cloud holds the power to transform IT processes and support business objectives. IT departments can use the cloud to redefine the continuum of development and operations—a process that is becoming known as DevOps. Download the Executive Brief DevOps: Why IT Operations Managers Should Care About the Cloud—prepared by Frost & Sullivan and sponsored by IBM—to learn how IBM SmartCloud Application services provide a robust platform that streamlines …

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds