Выбрать с первого столбца все уникальные значения

KolCells = .Cells(1, 1).End(xlDown).Row 
KolID = KolCells 
ReDim ID(KolCells) 
For ICells = 1 To KolCells 
ID(ICells) = .Cells(ICells, 1)

.Cells(1, 1).Select
    Selection.Insert Shift:=xlDown
    .Cells(1, 1).Select
    ActiveCell.FormulaR1C1 = ???
    .Select
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    .Cells(1, 1).Select
    Selection.Delete Shift:=xlUp
KolCells = .Cells(1, 1).End(xlDown).Row 
KolID = KolCells 
ReDim ID(KolCells) 
For ICells = 1 To KolCells 
ID(ICells) = .Cells(ICells, 1) 
    ActiveSheet.ShowAllData

Dim ID() As String
Sub Макрос()
Dim i As Integer, j As Integer, x As Integer
ReDim ID(x)
For i = 1 To Cells(1, 1).End(xlDown).Row
    If test(Cells(i, 1).Text) = False Then
        ReDim Preserve ID(x)
        ID(x) = Cells(i, 1).Text
        x = x + 1
    End If
Next i
For i = LBound(ID) To UBound(ID)
    Cells(i + 1, 2).Value = ID(i)
Next i
End Sub
Private Function test(newID) As Boolean
Dim i As Integer
For i = LBound(ID) To UBound(ID)
    If newID = ID(i) Then test = True: Exit Function
Next i
test = False
End Function

rivate Sub CommandButton1_Click()
 
     Dim MyPath As String 'Путь
     Dim MyFileName As String 'Название файл(ов) которые мы будем открывать
     Dim MyFileName_ As String 'Название файл(ов) которые мы будем открывать
     Dim ID() As Integer 'Массив ID которые по которым мы будет собирать данные
     Dim KolID As Integer 'Произвольное к-во ID?
     Dim KolCells As Integer 'Количество строчек по которым мы будет искать данные
     Dim KolRows As Integer 'Количество столбцов по которым мы будет искать данные
     Dim ICells As Integer, JCells As Integer, ICellsID ' Счетчикu для цикла
     Dim WorkMas() As String
     Dim MasStat() As Integer
     Dim Counter As Integer
     Dim theRange As Range
     Dim uniqueValues As New Collection
     Dim i As Integer
     Dim theArray() 'вот ваш массив
     Dim item As Variant
     Counter = 0
     MyPath_ = "C:\bd\"
     MyPath = "C:\xls\"
  
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call ImportTXT
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 With ActiveWorkbook.ActiveSheet
            KolCells = .Cells(1, 1).End(xlDown).Row
            KolID = KolCells
            ReDim ID(KolCells)
            For ICells = 1 To KolCells
                            ID(ICells) = .Cells(ICells, 1)
            'все что есть в первом столбце заносим в массив
            Next ICells
 End With
 
 
 ''''''''''''''''''''''''''
      MyFileName_ = "BD.xls" 'Пишем имя файла базы данных
     Workbooks.Open(MyPath_ & "\" & MyFileName_).Activate 'Открываем нужную нам книгу
         With ActiveWorkbook.ActiveSheet
             KolCells = .Cells(1, 1).End(xlDown).Row
             KolRows = .Cells(1, 1).End(xlToRight).Column
             ReDim WorkMas(KolCells, KolRows)
             For ICells = 1 To KolCells
                 For ICellsID = 1 To KolID
If .Cells(ICells, 1) = ID(ICellsID) Then
                         Counter = Counter + 1
                         For JCells = 1 To KolRows
                             WorkMas(Counter, JCells) = .Cells(ICells, JCells)
 
                         ' Если тут есть нужный нам ID то заносим его в память
                         Next JCells
End If
                 Next ICellsID
             Next ICells
         End With
     ActiveWindow.Close 'Закрываем книгу
     ' Все что нам надо у нас есть в памяти=))
     'Все что есть выводим
     ReDim MasStat("20")
     For ICells = 1 To Counter
         For JCells = 1 To KolRows
 
             If WorkMas(ICells, JCells) = "Значение1" Then MasStat(1) = MasStat(1) + 1
             If WorkMas(ICells, JCells) = "Значение2" Then MasStat(2) = MasStat(2) + 1
             Cells(ICells, JCells) = WorkMas(ICells, JCells)
 
         Next JCells
     Next ICells
 
             End Sub
             
             
             Sub ImportTXT()
        Cells(1, 1).Select
        Application.ScreenUpdating = False
         
        MyFile = Application.GetOpenFilename("(*.txt),*.txt)")
     
        If MyFile = False Then Exit Sub
     
        Workbooks.OpenText Filename:=MyFile, Origin:=866, StartRow:=1, _
            DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
            :=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other _
            :=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:= _
            True
         
        MyFile = ActiveWorkbook.Name
        Workbooks(MyFile).Sheets(1).UsedRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ThisWorkbook.Sheets("Лист1").Range("A1"), Unique:=True
         
        Application.DisplayAlerts = False
         
        Workbooks(MyFile).Close
         
        Application.DisplayAlerts = True
         
        Application.ScreenUpdating = True
     
End Sub