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 *