Can I use VBA function to return a (dynamic) list of acceptable values into Excel's data validation?

Question

For a given cell, I select Data/Validation and set Allow to \"List\". I now wish to set Source like so:

=rNames(REGS)

but that does not work (name not found

Answer 1

Couln't you rather use dynamic range names ? That's quite easy and does not require any vba.

Answer 2

I was just doing some research on accessing the contents of a Shapes dropdown control, and discovered another approach to solving this problem that you might find helpful.

Any range that can have a validation rule applied can have that rule applied programmatically. Thus, if you want to apply a rule to cell A1, you can do this:

ActiveSheet.Range("A1").Validation.Add xlValidateList, , , "use, this, list"

The above adds an in-cell dropdown validation that contains the items "use," "this," and "list." If you override the Worksheet_SelectionChange() event, and check for specific ranges within it, you can call any number of routines to create/delete validation rules. The beauty of this method is that the list referred to can be any list that can be created in VBA. I needed a dynamically-generated list of an ever-changing subset of the worksheets in a workbook, which I then concatenated together to create the validation list.

In the Worksheet_SelectionChange() event, I check for the range and then if it matches, fire the validation rule sub, thus:

Private Sub Worksheet_SelectionChange(ByVal Target as Range)

    If Target.Address = "$A$1" Then
        UpdateValidation
    End If

End Sub

The validation list-builder code in UpdateValidation() does this:

Public Sub UpdateValidation()

    Dim sList as String
    Dim oSheet as Worksheet

    For Each oSheet in Worksheets
        sList = sList & oSheet.Name & ","
    Next

    sList = left(sList, len(sList) -1)  ' Trim off the trailing comma

    ActiveSheet.Range("A1").Validation.Delete
    ActiveSheet.Range("A1").Validation.Add xlValidateList, , , sList

End Sub

And now, when the user clicks the dropdown arrow, he/she will be presented with the updated validation list.

Answer 3

Sounds like your rNames function is probably returning a 1-dimensional array (which will be treated as a row).
Try making your function return a column as a 1-based 2-dimensional array (Ansa(1,1) then Ansa(2,1) etc)

Answer 4

I think the problem is that data validation dialog only accepts the following "lists":

• an actual list of things entered directly into the Source field

• a literal range reference (like $Q$42:$Q$50)

• a named formula that itself resolves to a range reference

That last one is key - there is no way to have a VBA function just return an array that can be used for validation, even if you call it from a named formula.

You can write a VBA function that returns a range reference, though, and call that from a named formula. This can be useful as part of the following technique that approximates the ability to do what you actually want.

First, have an actual range somewhere that calls your arbitrary-array-returning VBA UDF. Say you had this function:

Public Function validationList(someArg, someOtherArg)

    'Pretend this got calculated somehow based on the above args...
    validationList = Array("a", "b", "c")
End Function

And you called it from $Q$42:$Q$50 as an array formula. You'd get three cells with "a", "b", and "c" in them, and the rest of the cells would have #N/A errors because the returned array was smaller than the range that called the UDF. So far so good.

Now, have another VBA UDF that returns just the "occupied" part of a range, ignoring the #N/A error cells:

Public Function extractSeq(rng As Range)

    'On Error GoTo EH stuff omitted...

    'Also omitting validation - is range only one row or column, etc.

    Dim posLast As Long
    For posLast = rng.Count To 1 Step -1
        If Not IsError(rng(posLast)) Then
            Exit For
        End If

        If rng(posLast) <> CVErr(xlErrNA) Then
            Exit For
        End If
    Next posLast

    If posLast < 1 Then
        extractSeq = CVErr(xlErrRef)
    Else
        Set extractSeq = Range(rng(1), rng(posLast))
    End If
End Function

You can then call this from a named formula like so:

=extractSeq($Q$42:$Q$50)

and the named formula will return a range reference that Excel will accept an allowable validation list. Clunky, but side-effect free!

Note the use of the keyword 'Set' in the above code. It's not clear from your question, but this might be the only part of this whole answer that matters to you. If you don't use 'Set' when trying to return a range reference, VBA will instead return the value of the range, which can't be used as a validation list.

Answer 5

For the future:

Following is then used in a named range and the named range set as the 'Data Validation' 'List' value

Function uniqueList(R_NonUnique As Range) As Variant

    Dim R_TempList As Range
    Dim V_Iterator As Variant
    Dim C_UniqueItems As New Collection

    On Error Resume Next
    For Each V_Iterator In R_NonUnique
        C_UniqueItems.Add "'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, CStr(V_Iterator.Value2)
    Next V_Iterator
    On Error GoTo 0

    For Each V_Iterator In C_UniqueItems
        If R_TempList Is Nothing Then
            Set R_TempList = Range(V_Iterator)
        End If
        Set R_TempList = Union(R_TempList, Range(V_Iterator))
    Next V_Iterator

    Set uniqueList = R_TempList

End Function

Answer 6

@user5149293 I higly appreciate your code, but I recommend to prevent the collection from throwing an error, when adding duplicate values. The usage of a custom formula in the data validation list or in Name-Manager-Formula prevents the code from using the vbe debugger, which makes it very hard to trace back errors here (I ran into this problem myself, when using your code). I recommend to check the existence of key in the collection with a separate function:

    Function uniqueList(R_NonUnique As Range) As Variant
    'Returns unique list as Array

        Dim R_TempList As Range
        Dim V_Iterator As Variant
        Dim C_UniqueItems As New Collection

        For Each V_Iterator In R_NonUnique
           'Check if key already exists in the Collection
           If Not HasKey(C_UniqueItems, V_Iterator.Value2) Then
              C_UniqueItems.Add Item:="'" & V_Iterator.Parent.Name & "'!" & V_Iterator.Address, Key:=CStr(V_Iterator.Value2)
           End If
        Next V_Iterator

        For Each V_Iterator In C_UniqueItems
            If R_TempList Is Nothing Then
                Set R_TempList = Range(V_Iterator)
            End If
            Set R_TempList = Union(R_TempList, Range(V_Iterator))
        Next V_Iterator

        Set uniqueList = R_TempList

    End Function


    Function HasKey(coll As Collection, strKey As String) As Boolean
    'https://stackoverflow.com/questions/38007844/generic-way-to-check-if-a-key-is-in-a-collection-in-excel-vba
        Dim var As Variant
        On Error Resume Next
        var = coll(strKey)
        HasKey = (Err.Number = 0)
        Err.Clear

    End Function