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

  • Live Event Date: October 29, 2014 @ 11:00 a.m. ET / 8:00 a.m. PT Are you interested in building a cognitive application using the power of IBM Watson? Need a platform that provides speed and ease for rapidly deploying this application? Join Chris Madison, Watson Solution Architect, as he walks through the process of building a Watson powered application on IBM Bluemix. Chris will talk about the new Watson Services just released on IBM bluemix, but more importantly he will do a step by step cognitive …

  • Agile methodologies give development and test teams the ability to build software at a faster rate than ever before. Combining DevOps with hybrid cloud architectures give teams not just the principles, but also the technology necessary to achieve their goals. By combining hybrid cloud and DevOps: IT departments maintain control, visibility, and security Dev/test teams remain agile and collaborative Organizational barriers are broken down Innovation and automation can thrive Download this white paper to …

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds