I have a listbox with more than 200 items, when I add another item I can't check for duplicate items. How to prevent adding duplicate items?
Printable View
I have a listbox with more than 200 items, when I add another item I can't check for duplicate items. How to prevent adding duplicate items?
There's an API and a Constant that you can use to check the string you have with the entries in the Listbox. It doesn't require a loop
Code:Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const LB_ADDSTRING = &H180
Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long
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 Sub Command1_Click()
Dim strStringToBeAdded As String
strStringToBeAdded = "ABCDEFG"
If SendMessageString(List1.hwnd, LB_FINDSTRINGEXACT, -1&, strStringToBeAdded) > -1 Then
'
' It's in the list so don't add it
'
Else
'
' It's not in the list so add it
'
SendMessage List1.hwnd, LB_ADDSTRING, 0, ByVal strStringToBeAdded
End If
'
'
End Sub
You could certainly, loop through the items and see if it's already there.
Another alternative would be to mirror the listbox's items with a Collection. With a Collection, you could place the items into it as both the "Item" and the "Key" (string). You're not allowed to use duplicate Keys in a Collection, so a bit of error trapping would give you the answer.
Also, Collections are much faster at searching keys than looping through a listbox would be.
Regards,
Elroy
Here, something like this is what I'd propose. If you further manipulate the listbox though, you'd need to do further work with the collection to make sure it stayed mirrored:
Code:
Option Explicit
Dim coll As New Collection
Private Sub Form_Load()
Dim i As Long
Dim s As String
For i = 1 To 1000
s = sRandomString(2)
If bAddedToCollection(s) Then List1.AddItem s
Next i
MsgBox List1.ListCount
End Sub
Public Function bAddedToCollection(sData As String) As Boolean
' Returns false if already in collection.
On Error GoTo HadError
coll.Add sData, sData
bAddedToCollection = True
HadError:
End Function
Public Function sRandomString(iLength As Integer) As String
Dim i As Integer
Dim j As Integer
Dim s As String
Static b As Boolean
'
If Not b Then
Randomize
b = True
End If
'
Do Until j = iLength
' This returns an integer from 48 to 83.
i = Int(36 * Rnd + 48)
' Skip over characters between 9 and A.
If i > 57 Then i = i + 7
' Now, i is between 48 and 57 or 65 and 90.
' "0" "9" "A" "Z"
s = s + Chr$(i)
j = j + 1
Loop
sRandomString = s
End Function
EDIT1: Vb6Lovers code also looks quite interesting, and it's certainly more memory efficient than mine.
EDIT2: However, just out of curiousity, I timed both methods. The Collection method seems to be WAY faster. I suspect that this is true because the API still has to loop through the listbox, and a collection has a binary-tree index that can be searched (which is much faster than a loop).
After running it a few times, my results were:
And here's my patched up code I used to test the timing:Code:API Seconds: 1.574219
Collection Seconds: 0.3046875
API Seconds: 1.546875
Collection Seconds: 0.3007813
API Seconds: 1.5625
Collection Seconds: 0.296875
Code:Option Explicit
Dim coll As New Collection
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const LB_ADDSTRING = &H180
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
'
Public Function bFoundInListBox(s As String, lst As ListBox) As Boolean
Dim iRet As Long
iRet = SendMessage(lst.hwnd, LB_FINDSTRINGEXACT, -1&, ByVal s)
bFoundInListBox = iRet > -1&
End Function
Private Sub Form_Load()
Dim i As Long
Dim s As String
Dim nStart As Single
nStart = Timer
For i = 1 To 3000
s = sRandomString(3)
If Not bFoundInListBox(s, List1) Then List1.AddItem s
Next i
Debug.Print "API Seconds: "; Timer - nStart
nStart = Timer
For i = 1 To 3000
s = sRandomString(3)
If bAddedToCollection(s) Then List2.AddItem s
Next i
Debug.Print "Collection Seconds: "; Timer - nStart
MsgBox List1.ListCount
End Sub
Public Function bAddedToCollection(sData As String) As Boolean
' Returns false if already in collection.
On Error GoTo HadError
coll.Add sData, sData
bAddedToCollection = True
HadError:
End Function
Public Function sRandomString(iLength As Integer) As String
Dim i As Integer
Dim j As Integer
Dim s As String
Static b As Boolean
'
If Not b Then
Randomize
b = True
End If
'
Do Until j = iLength
' This returns an integer from 48 to 83.
i = Int(36 * Rnd + 48)
' Skip over characters between 9 and A.
If i > 57 Then i = i + 7
' Now, i is between 48 and 57 or 65 and 90.
' "0" "9" "A" "Z"
s = s + Chr$(i)
j = j + 1
Loop
sRandomString = s
End Function
This was partly my idea (I went looking for similar), and found this -
http://www.planet-source-code.com/vb...56690&lngWId=1
I have tidied up the relevant code a bit to this -
I am not saying it is the best solution, but I throw it in for your considerationCode:Dim bAddingItem As Boolean
Private Sub cmdAddItemButPreventDuplicate_Click() 'add item to list PROVIDED IT IS NOT A DUPLICATE
Text1.Text = Trim(Text1.Text)
If Len(Text1.Text) = 0 Then
Text1.SetFocus
Exit Sub '<== EXIT
End If
bAddingItem = True '<== Prevent a couple of events during this duplicate check
List1.Text = Text1.Text
If List1.ListIndex > -1 Then
MsgBox "Duplicate Item", vbInformation, "DUPLICATE NOT ALLOWED"
bAddingItem = False
Exit Sub '<== EXIT
End If
List1.ADDITEM Text1.Text
bAddingItem = False
End Sub
Private Sub List1_Click()
If bAddingItem Then
Exit Sub '<== EXIT
End If
Text1.Text = List1.Text
End Sub
Private Sub Text1_Change()
If bAddingItem Then
Exit Sub '<== EXIT
End If
If Check1.Value = 1 And Len(Text1.Text) >= 4 Then List1.Text = Text1.Text
End Sub
Rob
PS I also came across this -
http://www.devx.com/tips/Tip/13869
Using the API from that last link I posted above, have this in the Form's code -
And this in a BAS fileCode:Private Sub cmdAddItemButPreventDuplicate_Click() 'add item to list PROVIDED IT IS NOT A DUPLICATE
Text1.Text = Trim(Text1.Text)
If Len(Text1.Text) = 0 Then
Text1.SetFocus
Exit Sub '<== EXIT
End If
If Not ChkListDuplicates(List1.hWnd, Text1.Text) Then
List1.AddItem Text1.Text
Else
sMsg = "That entry already exists."
MsgBox sMsg, vbExclamation, " DUPLICATE NOT ALLOWED"
Exit Sub '<== EXIT
End If
End Sub
Code:Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As _
Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Const LB_FINDSTRINGEXACT = &H1A2
Function ChkListDuplicates(chwnd As Long, StrText As String) As Boolean
ChkListDuplicates = (SendMessageByString(chwnd, LB_FINDSTRINGEXACT, -1, StrText) > -1)
End Function