How do you remove duplicates from a list box?

[claytrainor]

i need to get rid of duplicate entries in a listbox? how would i go about this?

thanks alot

[zynder]

For i=List1.listcount-1 to 1 step -1
      IF List1.List(i)=List1.List(i-1) Then 
          List1.RemoveItem i
Next

[timeshifter]

That won't check to see if there are duplicates later on in the code. To do that, you'd need two loops, as such. Forgive me if its' buggy, I don't have VB open. I'm running off of zynder's code:

For i = List1.ListCount - 1 to 1 Step -1
   [b]For j = i To 1 Step -1[/b]
      If List1.List(i) = List1.List(j) Then List1.RemoveItem i
   [b]Next j[/b]
Next i

As I said, probably a little buggy, but it's the idea that you need.

[leinad31]

You could transfer the listbox strings to a collection, set the item and key arguments on collection.Add equal to the string in the listbox... since keys have to be unique in a collection adding repeating keys generates an error... handle the error and continue adding to the collection.

After transferring to the collection, clear the listbox and move the strings back to the listbox from the collection.

The iterations are one pass through the listbox items, plus one pass through the collection object.

EDIT: Here try this

Private Sub Form_Load()
Dim mycol As New Collection
Dim cnt As Long
 
On Error Resume Next
   For cnt = 0 To List1.ListCount - 1
      mycol.Add List1.List(cnt), List1.List(cnt)
   Next
   If Err Then Err.Clear
On Error GoTo 0
 
   List1.Clear
   For cnt = 1 To mycol.Count
      List1.AddItem mycol(1)
   Next
End Sub

[bushmobile]

use API, something like this (untested):

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 Const LB_FINDSTRINGEXACT = &H1A2
 
Private Sub Command1_Click()
    Dim lPos As Long, N As Long
 
    Do While N < List1.Count
        Do
            lPos = SendMessage(List1.hWnd, LB_FINDSTRINGEXACT, N, ByVal List1.List(N))
            If lPos > -1 Then List1.RemoveItem lPos
        Loop While lPos > -1
        N = N + 1
    Loop
End Sub

[Ericson]

use API, something like this (untested):

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 Const LB_FINDSTRINGEXACT = &H1A2
 
Private Sub Command1_Click()
    Dim lPos As Long, N As Long
 
    Do While N < List1.Count
        Do
            lPos = SendMessage(List1.hWnd, LB_FINDSTRINGEXACT, N, ByVal List1.List(N))
            If lPos > -1 Then List1.RemoveItem lPos
        Loop While lPos > -1
        N = N + 1
    Loop
End Sub

You should always delete in a reversed order, loop from List1.Listcont-1 to 0 otherwise you will skip every item following a deleted item.

EDIT: My mistake, i didn't read the code carefully enough.

[Keithuk]

This question has been asked many times before, do a search.

[gavio]

@timeshifter: althow that method will remove all duplicates it's very very slow...

I would suggest to use the API bushmobile provided...