FindDupListBox

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

'Try this, it works fastest With a Sorted List, but Is

'still quick either way..

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