CODEWITHSUNDEEP
vbaexcelduplicateslistboxitem
Rosario
Rosario

Reputation: 47

VBA Removing ListBox Duplicates

I'm trying to add a list of names from another worksheet that has duplicates. On the listbox, I want to have unique names, instead of duplicates. The following code is not sorting them for duplicates, it errors out. Any help is appreciated.

Dim intCount As Integer
Dim rngData As Range
Dim strID As String
Dim rngCell As Range
dim ctrlListNames as MSForms.ListBox
Set rngData = Application.ThisWorkbook.Worksheets("Names").Range("A").CurrentRegion

'declare header of strID and sort it
strID = "Salesperson"
rngData.Sort key1:=strID, Header:=xlYes
'Loop to add the salesperson name and to make sure no duplicates are added
For Each rngCell In rngData.Columns(2).Cells
    If rngCell.Value <> strID Then
        ctrlListNames.AddItem rngCell.Value
        strID = rngCell.Value
    End If
Next rngCell

Upvotes: 1

Views: 10047

Answers (3)

Jay
Jay

Reputation: 21

It says invalid property array index because the list gets shortened after the removal of entries. if we use FOR, the end value is static, therefore, we need to use DO while loop. Use the following code to remove duplicates.

Count = ListBox1.ListCount - 1

i = 0
j = 0

Do While i <= Count
j = i + 1
Do While j <= Count
If ListBox1.List(i) = ListBox1.List(j) Then
ListBox1.RemoveItem (j)
Count = ListBox1.ListCount - 1  'Need to update list count after each removal. 
End If
j = j + 1
Loop
i = i + 1
Loop

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149295

Way 1

Use this to remove the duplicates

Sub Sample()
    RemovelstDuplicates ctrlListNames
End Sub

Public Sub RemovelstDuplicates(lst As msforms.ListBox)
    Dim i As Long, j As Long
    With lst
        For i = 0 To .ListCount - 1
            For j = .ListCount - 1 To (i + 1) Step -1
                If .List(j) = .List(i) Then
                    .RemoveItem j
                End If
            Next
        Next
    End With
End Sub

Way 2

Create a unique collection and then add it to the listbox

Dim Col As New Collection, itm As Variant

For Each rngCell In rngData.Columns(2).Cells
    On Error Resume Next
    Col.Add rngCell.Value, CStr(rngCell.Value)
    On Error GoTo 0
Next rngCell

For Each itm In Col
    ctrlListNames.AddItem itm
Next itm

Upvotes: 5

Rosario
Rosario

Reputation: 47

Private Sub Workbook_Open()
Dim ctrlListNames As MSForms.ListBox
Dim i As Long
Dim j As Long

ctrlListNames.List = Application.ThisWorkbook.Worksheets("Names").Range("Salesperson").Value


With ctrlListNames
For i = 0 To .ListCount - 1
    For j = .ListCount To (i + 1) Step -1
        If .List(j) = .List(i) Then
            .RemoveItem j
        End If
    Next
Next
End With


End Sub

And it says invalid property array index.

Upvotes: 1

Related Questions