使用单元格下拉列表中的值填充 vba ComboBox

Question

I want to populate a comboBox with the drop-down values found in a particular cell, say C10.

C10 uses Excel's Data Validation functionality to limit the values that can be entered into a cell to a drop-down list. I want to use this list to populate the comboBox in a vba userForm.

Currently my approach is to use:

Range("C10").Validation.Formula1

Here is 3 arbitrary examples of what this can return:

1. "=Makes"
2. "=INDIRECT(C9 & "_MK")"
3. "0;1;2;3;4;5;6;7;8;9;10"

My approach is to evaluate this and try to form it into a usable range that can be used to set the RowSource property of my comboBox. However, I can't account for every feasible case that can be returned.

Surely there is a short and simple way to achieve what I want without without coding an exception for every case.

What is the correct way of doing this?

Answer 1

However, I can't account for every feasible case that can be returned.

You will have to account for it separately. There is no direct way to get those values.

Here is a quick code GetDVList() that I wrote which will handle all your 3 scenarios.

The below code will return the values of the Data Validation list in an array from which you can populate the Combobox. I have commented the code so you should not have a problem understanding it but if you do then simply ask.

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim rng As Range
    Dim i As Long
    Dim cmbArray As Variant
    
    '~~> Change this to the relevant sheet and range
    Set rng = Sheet1.Range("A1")
    
    '~~> Check if range has data validation
    On Error Resume Next
    i = rng.SpecialCells(xlCellTypeSameValidation).Count
    On Error GoTo 0
    
    '~~> If no validation found then exit sub
    If i = 0 Then
        MsgBox "No validation found"
        Exit Sub
    End If
    
    '~~> The array of values
    cmbArray = GetDVList(rng)
    
    '~~> You can transfer these values to Combobox
    For i = LBound(cmbArray) To UBound(cmbArray)
        Debug.Print cmbArray(i)
    Next i
End Sub

Function GetDVList(rng As Range) As Variant
    Dim tmpArray As Variant
    Dim i As Long, rw As Long
    Dim dvFormula As String
    
    dvFormula = rng.Validation.Formula1
    
    '~~> "=Makes"
    '~~> "=INDIRECT(C9 &_MK)"
    If Left(dvFormula, 1) = "=" Then
        dvFormula = Mid(dvFormula, 2)
        
        rw = Range(dvFormula).rows.Count
        
        ReDim tmpArray(1 To rw)
        
        For i = 1 To rw
            tmpArray(i) = Range(dvFormula).Cells(i, 1)
        Next i
    '~~> "0;1;2;3;4;5;6;7;8;9;10"
    Else
        tmpArray = Split(dvFormula, ",") '~~> Use ; instead of , if required
    End If

    GetDVList = tmpArray
End Function

Answer 2

Please, test the next code. It works with the assumption that a List Validation formula can only return a Range or a list (array). Theoretically, it should evaluate any formula and extract what it returns, in terms of a Range or a List:

Sub comboListValidation()
 Dim cel As Range, arr, arrV
 Dim cb As OLEObject  'sheet ActiveX combo
 
 Set cb = ActiveSheet.Shapes("ComboBox1").OLEFormat.Object
 
 Set cel = ActiveCell 'instead of active cell you can use what you need
                      'even a cell resulted from iteration between `sameValidation` range
 
 arrV = isCellVal(cel) 'check if chell has validadion (and DropDown type)
 If Not arrV(0) Then
    MsgBox "No validation for cell """ & cel.Address & """.": Exit Sub
 ElseIf Not arrV(1) Then
    MsgBox "cell """ & cel.Address & """ has validation but not DropDown type.": Exit Sub
 End If
 
 arr = listValidation_Array(cel)
 
 With cb.Object
    .Clear      'clear the existing items (if any)
    .list = arr 'load the combo using arr
 End With
 MsgBox "Did it..."
End Sub

Private Function listValidation_Array(cel As Range) As Variant
  Dim strForm As String, rngV As Range, strList As String, arr

  strForm = cel.Validation.Formula1         'extract Formula1 string
  On Error Resume Next
   Set rngV = Application.Evaluate(strForm) '!!!try setting the evaluated range!!!
   If Err.Number = 424 Then 'if not a Range, it must be a list (usually, comma separated)
        Err.Clear: On Error GoTo 0
        listValidation_Array = Split(Replace(strForm, ";", ","), ",") 'treat the ";" sep, too
   Else
        On Error GoTo 0
        listValidation_Array = rngV.Value   'extract the array from range
   End If
End Function

Function isCellVal(rng As Range) As Variant
 Dim VType As Long
 Dim boolValid As Boolean, boolDropDown As Boolean
 
 On Error Resume Next
  VType = rng.Validation.Type 'check if validation exists
 On Error GoTo 0

 If VType >= 1 Then           'any validation type
     boolValid = True
     If VType = 3 Then boolDropDown = True 'dropDown type
 End If
 ReDim arr(1) : arr(0) = boolValid: arr(1) = boolDropDown
 isCellVal = arr
End Function