Detecting / Counting Duplicate Items in a ListBox

WEBINAR: On-demand webcast

How to Boost Database Development Productivity on Linux, Docker, and Kubernetes with Microsoft SQL Server 2017 REGISTER >

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

  • As all sorts of data becomes available for storage, analysis and retrieval - so called 'Big Data' - there are potentially huge benefits, but equally huge challenges...
  • The agile organization needs knowledge to act on, quickly and effectively. Though many organizations are clamouring for "Big Data", not nearly as many know what to do with it...
  • Cloud-based integration solutions can be confusing. Adding to the confusion are the multiple ways IT departments can deliver such integration...

Most Popular Programming Stories

More for Developers

RSS Feeds

Thanks for your registration, follow us on our social networks to keep up-to-date