Removing duplicates from a list box

[claytrainor]

i'm using this code to remove duplicates from a listbox

For i = List1.ListCount - 1 To 1 Step -1
      If List1.List(i) = List1.List(i - 1) Then
          List1.RemoveItem i
        End If
Next i

and it works if the list's are small, but if i have over 1000 entries like i do normally, it doesnt remove duplicates.

any idea?

[thingimijig]

That will only work if the listbox is sorted because you are always comparing the next item up and not any other item. For a fast way of deleting duplicates is to either check for the item before adding a new item to the listbox or use this

Option Explicit
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
Const LB_FINDSTRINGEXACT = &H1A2
 
'--------------------------------------
 
For i = List1.ListCount - 1 To 0 Step -1
  If SendMessageString(List1.hwnd, LB_FINDSTRINGEXACT, -1, ByVal List1.List(i)) <> i Then
    List1.RemoveItem i
   End If
  Next i

[bushmobile]

i posted this in your previous thread on removing duplicates from listboxes:

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.ListCount
        Do
            lPos = SendMessage(List1.hwnd, LB_FINDSTRINGEXACT, N, ByVal List1.List(N))
            If lPos > N Then List1.RemoveItem lPos
        Loop While lPos > N
        N = N + 1
    Loop
End Sub

Edit: was untested - corrected it so it works

[claytrainor]

excellent, thank you so much