'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 |