Checking a Listbox for duplicate Items

Alright, I was not sure how to really do this. What I want to do, is run through a listbox and check if there are any duplicate items in the box. As in more then one of the exact same item in the listbox. I know how to run through it and like the basic structure, but the checking has got me stumped.

Would you be interested in a way to prevent the duplicates in the first place?

VB Code:

Private Function ChkLst(iList As ListBox)
    Dim i As Integer, x As Integer
        For i = 0 To iList.ListCount - 1
            For x = 0 To iList.ListCount - 1
                If (iList.List(i) = iList.List(x)) And x <> i Then
                    List1.RemoveItem (i)
                End If
            Next x
        Next i
        MsgBox iList.ListCount
End Function
 
Private Sub Command1_Click()
    Call ChkLst(List1)
End Sub

I always wonder why you would want do that when you don't have to. Just add this code and you won't have duplicates to get rid of.

VB Code:

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
 
' In a sub
    Dim lngRetVal As Long
 
    lngRetVal = SendMessageString(MyListbox.hwnd, _
                                  LB_FINDSTRINGEXACT, -1&, _
                                  strStringToBeAdded)
    ' lngRetVal is the ListIndex
    If lngRetVal > -1& Then
        ' It's in the list
    Else
        ' It's not in the list so add it
        Call SendMessage(MyListbox.hwnd, LB_ADDSTRING, 0, ByVal strStringToBeAdded)
    End If

But that code has to fire every time anything is inputted, why waste the speed?

I'm sure that the length of time it takes to run my code is much less then the time to loop through an existing list, particularly if it is a large list.

I just ran a test and in a list with 200 entries removing duplicates after the fact took 200+ milliseconds while preventing them in the first place took only 30+ milliseconds.

I forgot a couple of declarations in my code above.

Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const LB_ADDSTRING = &H180

Your code crashes vb

VB Code:

Call SendMessage(MyListbox.hwnd, LB_ADDSTRING, 0, ByVal strStringToBeAdded)

Wow, I messed myself up not using a collection.
This doesn't do anything but display the dups. Not elegant, but works.
Commented, also :wave:

VB Code:

Option Explicit
 
Private Sub Form_Load()
  List1.AddItem "123"
  List1.AddItem "456"
  List1.AddItem "123"
  List1.AddItem "456"
  FindDups
End Sub
 
Sub FindDups()
  Dim c As Integer, lc As Integer, dp As Integer
  Dim x As Integer, y As Integer, dc As Integer
  Dim temp As String, dups() As String
  Dim str As String, g As Integer
  Dim found As Boolean
  c = List1.ListCount - 1
  ReDim arr(c) As String
  dc = 0
  For x = 0 To c
    arr(x) = List1.List(x) ' Load into array
  Next x
  For x = 0 To c
    temp = List1.List(x) ' use one item at a time
    lc = 0
    For y = 0 To c
      If temp = arr(y) Then ' compare to array to find dups
         lc = lc + 1
      End If
    Next y
    If lc > 1 Then ' if dups
      For dp = 0 To dc
        If dc > 0 Then
          For g = 0 To dc - 1 ' check if already in list
            If dups(g) = List1.List(x) Then
              found = True  ' already in list
              Exit For
            End If
          Next g
        End If
        If found = True Then Exit For
        ReDim Preserve dups(dc) As String
        dups(dc) = List1.List(x) ' add to list
        dc = dc + 1
      Next dp
    End If
  Next x
  '  display list
  str = "  Dups" & vbCrLf
  For x = 0 To dc - 1
    str = str & dups(x) & vbCrLf
  Next x
  MsgBox str
End Sub

To answer the original question, if you sorted the listbox first, you could amend 2eM!x's code to make it faster:

Quote:

---

Originally Posted by |2eM!x

VB Code:

Private Function ChkLst(iList As ListBox)
    Dim i As Integer, x As Integer
        For i = 0 To iList.ListCount - 1
            [COLOR=Red]For x = i + 1 To iList.ListCount - 1[/COLOR]
                If (iList.List(i) = iList.List(x)) And x <> i Then
                    List1.RemoveItem (i)
                [COLOR=Red]else
                    Next i[/COLOR]
                End If
            Next x
        Next i
        MsgBox iList.ListCount
End Function
 
Private Sub Command1_Click()
    Call ChkLst(List1)
End Sub

---

Actually I've just realised the code from #3 or #10 would only remove alternate instances of duplicates. If say i was 1 and item 2 was identical, you remove item 2, so item 3 becomes item 2, and never gets checked. Change it to:

VB Code:

Private Function ChkLst(iList As ListBox)
    Dim i As Integer, x As Integer
        For i = 0 To iList.ListCount - 1
            do while iList.ListCount > i + 2
                If (iList.List(i) = iList.List(i+1)) Then
                    List1.RemoveItem (i + 1)
                else
                    Next i
                End If
            loop
        Next i
        MsgBox iList.ListCount
End Function
 
Private Sub Command1_Click()
    Call ChkLst(List1)
End Sub

Quote:

---

Originally Posted by |2eM!x

Your code crashes vb

VB Code:

Call SendMessage(MyListbox.hwnd, LB_ADDSTRING, 0, ByVal strStringToBeAdded)

---

Not if used correctly. Is the variable that you used for strStringToBeAdded actually a string?

For anyone who is interested I've attached a project that does it both ways. BTW, I modified my code slightly and now it runs in about 16 ms.