Sub DataValDocumenter()
'adapted from code posted by J.E. McGimpsey 2005-02-03
'http://www.mcgimpsey.com/excel/index.html
Dim sVal(0 To 2) As Variant
Dim rValidation As Range
Dim rCell As Range
Dim nFile As Long
Dim sC As String
Dim strDV As String
sC = vbTab
On Error Resume Next
Set rValidation = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If Not rValidation Is Nothing Then
nFile = FreeFile
Open "test.txt" For Output As #nFile
For Each rCell In rValidation
With rCell.Validation
sVal(0) = Choose(.Type + 1, "Input Only", _
"Whole Number", "Decimal", "List", "Date", _
"Time", "Text Length", "Custom")
sVal(1) = .Formula1
sVal(2) = .Formula2
Select Case .Type
Case xlValidateWholeNumber, xlValidateDecimal, _
xlValidateDate, xlValidateTime, xlValidateCustom
Select Case .Operator
Case xlAnd
strDV = "Between" & sC & sVal(1) & sC & "And" & sC & sVal(2)
Case xlNotBetween
strDV = "Not Between" & sC & sVal(1) & sC & "And" & sC & sVal(2)
Case xlEqual
strDV = "Equal to" & sC & sVal(1)
Case xlNotEqual
strDV = "Not Equal to" & sC & sVal(1)
Case xlGreater
strDV = "Greater Than" & sC & sVal(1)
Case xlLess
strDV = "Less Than" & sC & sVal(1)
Case xlGreaterEqual
strDV = "Greater Than or Equal to" & sC & sVal(1)
Case xlLessEqual
strDV = "Less Than or Equal to" & sC & sVal(1)
Case Else
'do nothing
End Select
Case Else
strDV = sVal(1)
End Select
End With
strDV = sC & sVal(0) & sC & strDV
Print #nFile, rCell.Address(False, False) & strDV
Erase sVal
Next rCell
Close #nFile
End If
End Sub
