VBA Removing ListBox Duplicates

Question

Я пытаюсь добавить список имен из другого листа с дубликатами. В списке я хочу иметь уникальные имена, а не дубликаты. Следующий код не сортирует их для дубликатов, это приводит к ошибкам. Любая помощь приветствуется.

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 

Answer 1

Way 1

Используется для удаления дубликатов

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

Создать уникальную коллекцию, а затем добавить его в 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 

Answer 2

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 

И он говорит о недопустимом индексе массива свойств.