Jumat, 24 September 2010

Remove Duplicate item in aListbox

Remove the Duplicates in a Listbox. Follow This code loops though a list (List1) checking each item with every other item, then when it finds a duplicate it removes it. Put this code in a button:

Dim i As Long, X As Long, Y As Long
For i = 0 To List1.ListCount - 1
For X = 0 To List1.ListCount - 1
If X <> i Then
If List1.List(i) = List1.List(X) Then
List1.RemoveItem X
X = X - 1
End If
End If
Next
Next

You can using another method to do it, this way is somewhat faster and uses some Windows API functions. First Make New Module:


Public 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

Public Function RemoveDuplicate(lpBox As ListBox) As Integer
Dim nCount As Integer, nPos1 As Integer, nPos2 As Integer, nDelete As Integer
Dim sText As String

If lpBox.ListCount < 3 Then
RemoveDuplicate = 0
Exit Function
End If

For nCount = 0 To lpBox.ListCount - 1
Do
DoEvents
sText = lpBox.List(nCount)
nPos1 = SendMessageByString(lpBox.hwnd, LB_FINDSTRINGEXACT, nCount, sText)
nPos2 = SendMessageByString(lpBox.hwnd, LB_FINDSTRINGEXACT, nPos1 + 1, sText)
If nPos2 = -1 Or nPos2 = nPos1 Then Exit Do
lpBox.RemoveItem nPos2
nDelete = nDelete + 1
Loop
Next nCount
RemoveDuplicate= nDelete
End Function

Then Make new Button then insert this code :
Private Sub Command1_Click()
Call RemoveDuplicate(List1)
End Sub

Related Post :



0 comments:

R