How to prevent duplicate item.

[Mahmood Khaleel Pira]

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?

[I Love VB6]

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

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

[Elroy]

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

[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:

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:

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:

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

[Bobbles]

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 -

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

[Bobbles]

Using the API from that last link I posted above, have this in the Form's 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

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