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

  • On-demand Event Event Date: October 23, 2014 Despite the current "virtualize everything" mentality, there are advantages to utilizing physical hardware for certain tasks. This is especially true for backups. In many cases, it is clearly in an organization's best interest to make use of physical, purpose-built backup appliances rather than relying on virtual backup software (VBA - Virtual Backup Appliances). Join us for this webcast to learn why physical appliances are preferable to virtual backup appliances, …

  • IBM Worklight is a mobile application development platform that lets you extend your business to mobile devices. It is designed to provide an open, comprehensive platform to build, run and manage HTML5, hybrid and native mobile apps.

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds