by C (2 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 25th April 2005
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
this code will help you when you need unique list items in a listbox or combobox
VBcoders
(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
No comments have been posted about this code will help you when you need unique list items in a listbox or combobox. Why not be the first to post a comment about this code will help you when you need unique list items in a listbox or combobox.
