How to prevent duplicate item.

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:

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

---

And here's my patched up code I used to test the timing:

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 -

Code:

---

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

---

I am not saying it is the best solution, but I throw it in for your consideration

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 -

Code:

---

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

---

And this in a BAS file

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

---