VBA validation list values

If you want to get the values that cell valuation can handle, use this piece of code:
Private Sub sGetValidationList()
    If Intersect(ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation), Selection) Is Nothing Then
    Else
        Call fGetValidationList(Selection, ";")
    End If
End Sub

Private Function fGetValidationList(ByVal Target As Excel.Range, _
                                    Optional ByVal strSeparator As String = ",") As String()
    Dim rgList As Range
    Dim strList As String
    Dim strWsh As String
    Dim lgPosition As Long
    
    Dim aValidation() As String
    Dim myVar As Variant
    Dim myItem As Variant
    Dim lgItem As Long

    If Intersect(Target.Parent.Cells.SpecialCells(xlCellTypeAllValidation), Target) Is Nothing Then
    Else
        ' Get the formula in the data validation
        strList = Target.Validation.Formula1
    
        ' Check if it has an = sign (case has a range or a named range)
        If VBA.InStr(1, strList, "=") > 0 Then
            lgPosition = VBA.InStr(1, strList, "!")
            If lgPosition > 0 Then
                lgPosition = 1
                strWsh = VBA.Mid$(strList, 1, VBA.InStr(1, strList, "!") - 1)
                strWsh = VBA.Replace$(strWsh, "=", "")
                strWsh = VBA.Replace$(strWsh, "'", "")
                strList = VBA.Mid$(strList, VBA.InStr(1, strList, "!") + 1)
                myVar = ThisWorkbook.Worksheets(strWsh).Range(strList).Value2
            Else
                myVar = Target.Parent.Range(VBA.Replace$(strList, "=", "")).Value2
            End If
        Else
        ' Case with a set of valid values
            If InStr(1, strList, strSeparator) > 0 Then
                myVar = Split(strList, strSeparator)
            Else
                aValidation = VBA.Split(strList, vbCrLf)
            End If
        End If
        
        ReDim Preserve aValidation(LBound(myVar, 1) To UBound(myVar, 1))
        lgItem = LBound(aValidation) - 1
        For Each myItem In myVar
            lgItem = lgItem + 1
            aValidation(lgItem) = myItem
        Next myItem
        Erase myVar
        fGetValidationList = aValidation
    End If
    
End Function
[/sourcecode]

Leave a Reply

Your email address will not be published. Required fields are marked *