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
        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
        ' 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
                myVar = Target.Parent.Range(VBA.Replace$(strList, "=", "")).Value2
            End If
        ' Case with a set of valid values
            If InStr(1, strList, strSeparator) > 0 Then
                myVar = Split(strList, strSeparator)
                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

Leave a Reply

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