Data Validation Dropdown List From Collection

[jmanwell]

I was wondering if there was a way in VBA to create a data validation dropdown list based on the items in a collection. Basically, what I have done is searched a database for a column header, selected items in that column, filtered out the unique values, and added those values to a collection. Now I would like those values added as a dropdown list through data validation. See code below:

Sub ColH()
Dim c As Range, i As Integer, e As Range, cells1 As Collection, cell1 As Range, range1 As Range
' Search for specific column header
For Each c In Range("A1:AA1")
    If InStr(1, c, "Program Manager", vbTextCompare) = 1 Then
        d = c.Address
    End If
Next c
'Select the cells I need and filter out unique values
Set e = Range(Range(d).Offset(1, 0), Range(d).End(xlDown).Offset(-13, 0))
With e
    .AdvancedFilter xlFilterCopy, , Range("BH2"), True
End With
Set range1 = Range("BH2", Range("BH" & Rows.Count).End(xlUp))
'Sort them and add to collection
Range(Range("BH2").Offset(1, 0), Range("BH2").End(xlDown).Offset(-1, 0)).Sort Range("BH3"), xlAscending

Set cells1 = New Collection
For Each cell1 In range1.Cells
Key = cell1.Row - range1.Row & "," & cell1.Column - range1.Column
cells1.Add cell1, Key
Next cell1
'Clear the range where they were sorted
With range1
    .ClearContents
    .Borders.LineStyle = xlNone
End With
Debug.Print cells1.Count
End Sub

If you know of a way to do this, it would be greatly appreciated.

Joe

 

[Weaver]

Hopefully this should give you a pointer

Sub setValidation()
    Set myCollection = Range("A1:A6")
    Set myValidatonRange = Range("D1:D10")
    myValidationStr = ""
    For Each c In myCollection
        myValidationStr = myValidationStr & c.Value & ","
    Next c
    myValidationStr = Left(myValidationStr, Len(myValidationStr) - 1)
    With myValidatonRange.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myValidationStr
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

My example just pulls some strings from A1:A6 (so in reality, I'd just refer to this range) but it's how it sets up the validation list that might be of interest to you.

HTH

 

[jmanwell]

It works GREAT! Thanks so much.