• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• this code will help you when you need unique list items in a listbox or combobox

this code will help you when you need unique list items in a listbox or combobox

this code will help you when you need unique list items in a listbox or combobox

Rate this code will help you when you need unique list items in a listbox or combobox

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

        (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