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]