Списки валидации и комбобоксы (AtiveX)

Sub Example_01() 'Заполнить список в D1 без повторов
Dim i As Long, x As New Collection, poz As Range, s As String
On Error Resume Next: Err.Clear
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
 If Cells(i, "A") <> vbNullString Then
 x.Add Cells(i, 1), CStr(Cells(i, 1))
 If Err = 0 Then s = s & "," & Cells(i, "A") Else Err.Clear
 End If
Next
On Error GoTo 0
With Range("D1").Validation
 .Delete: .Add Type:=xlValidateList, Formula1:=s
End With
End Sub

Sub Example_01_1() 'Заполнить список в D1 без повторов
Dim i As Long, x, s As String
s = ","
For Each x In Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
 If Len(x) Then If InStr(s, "," & x & ",") = 0 Then s = s & x & ","
Next
With Range("D1").Validation
 .Delete: .Add Type:=xlValidateList, Formula1:=s
End With
End Sub

Sub Example_01_3() 'Заполнить список в D1 без повторов с сортировкой
Dim x, i&, s As String
x = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
With CreateObject("System.Collections.ArrayList")
 For i = 1 To UBound(x)
 If Len(x(i, 1)) Then If Not .Contains(x(i, 1)) Then .Add x(i, 1)
 Next i
 .Sort
 ' .Insert 0, "Выбор ФИО" 'вставить Заголовок в 1-ю позицию (индекс 0)
 s = Join(.toarray, ",")
End With
With Range("D1").Validation
 .Delete: .Add Type:=xlValidateList, Formula1:=s
End With
End Sub

Sub Example_02() 'Заполнить ComboBox1 без повторов с сортировкой
'с использованием ф-ции NoDups от ZVI (см. Модуль2 в файле)
Dim Rng As Range
' чтобы не париться, можно задать весь столбец, NoDups ограничит его по UsedRange
Set Rng = Sheets("Sheet1").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
With Sheets(1).ComboBox1
 .Clear
 .List = NoDups(Rng)
 .ListIndex = 0
End With
End Sub