Заполнить combobox неповторяющимися данными из столбца excel

Sub InitBoxSort(B As MSForms.ComboBox)
Dim I As Long, C As Long, S$, L As Long, R As Long
For I = 2 To Cells.Rows.Count 'заполняем со второй строки
  S = Cells(I, 1)             'первого столбца
  If S = "" Then Exit For
  L = 0
  R = B.ListCount - 1
  Do While R >= L
    C = (R + L) \ 2
    Select Case StrComp(S, B.List(C))
      Case -1: R = C - 1
      Case 1: L = C + 1
      Case Else: GoTo NextI
    End Select
  Loop
  B.AddItem S, L
NextI:
Next I
End Sub
 
Private Sub UserForm_Initialize()
  InitBoxSort ComboBox1
End Sub

Sub Мак()
    Dim Arr()
    Dim i
    Dim Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
Arr() = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).Value
With Dict
    For i = 1 To N
        If .Exists(Arr(i)) Then
           .Item(Arr(i)) = .Item(Arr(i)) + 1
        Else
           .Add Arr(i), 1
        End If
    Next i
End With
Range("A1").Resize(Dict.Count) = Application.Transpose(Dict.keys)
Range("B1").Resize(Dict.Count) = Application.Transpose(Dict.items)
Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
MsgBox "ГОТОВО"
End Sub

Private Sub UserForm_Initialize()
Dim m
With Application
    .ScreenUpdating = False
    Set m = ActiveSheet
    m.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets.Add.Range("A1"), Unique:=True
    Rows(1).Delete
    [A1].Sort [A1], xlAscending, Header:=xlNo
    ComboBox1.List = ActiveSheet.UsedRange.Value
    .DisplayAlerts = False
    ActiveSheet.Delete
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub