Snippet Library

'Try this, it works fastest With a Sorted List, but Is still quick either way..
' Aaron Young...


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))
        '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)
        '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
;