DupCheck (2)




'Es.DupeRemove List1

Sub DupeRemove (Lst As ListBox)
On Error Resume Next
If Lst.ListCount = 0 Then Exit Sub
iCount = 0
Do Until Lst.ListIndex = Lst.ListCount - 1: DoEvents
Lst.ListIndex = iCount
iCheck1 = Lst.List(Lst.ListIndex)
If Lst.ListIndex = Lst.ListCount - 1 Then Exit Sub
iCheck2 = Lst.List(Lst.ListIndex + 1)
If NameFix(iCheck1) = NameFix(iCheck2) Then
Lst.RemoveItem Lst.ListIndex
': Label = Label + 1': DoEvents

Else
iCount = iCount + 1
End If
Loop
End Sub











( dupcheck2.html )- by Paolo Puglisi - Modifica del 17/12/2023