Validations - Building a list of

[Jac Tremblay]

Hi everyone
I'm trying to list some information on validations that are present in some columns of a workbook (with 24 worksheets). I will eventually have to reconstruct these validations on other workbooks
There are 2 types of validations. Either: 1- a list of values that gets its data from a named range and 2- a text length validation of the type "<= 5 characters"
I want to know how to skip a cell that do not contain a validation. The code I wrote gives an error and stops
I also want to distinguish between a validation that shows a list of values and a text length validation (the information to gather is different)
Where can I get the constant names and corresponding numbers (Type property xlValidateTextLength = 6, Operator xlLessEqual = 8, etc.)
Here is some of my code
'******************************************************************
Sub ListValidations(
Dim intNbSheets As Intege
Dim strWorkbook As Strin
Dim intI As Intege
Dim strSheetName As Strin
Dim intNoCol As Intege
Dim intNbColToDo As Intege
Dim strLetter As Strin
Dim strAddresse As Strin
Dim strValidation As Validatio
Dim strType As Strin
Dim strAlertStyle As Strin
Dim strOperator As Strin
Dim strFormula1 As Strin
Dim strFormula2 As Strin
Dim strValue As Strin

strWorkbook = ActiveWorkbook.Nam
intNbSheets = ActiveWorkbook.Sheets.Coun

' Activate utility worksheet
On Error GoTo ErrUtilityWorkshee
Windows("Utility.xls").Activat
Sheets("Lists of values").Activat

Range("A2:B20").Selec
Range("A2").Activat
Selection.Clea
Range("A2").Selec
Range("A2").Value = strWorkboo
Selection.Font.Bold = Tru
Range("A3").Selec

Windows(strWorkbook).Activat

For intI = 1 To intNbSheets -
Workbooks(strWorkbook).Sheets(intI).Activat
strSheetName = ActiveWorkbook.Sheets(intI).Nam
Windows("Utility.xls").Activat
ActiveCell.Value = "Sheet no " & int
Selection.Font.Bold = Tru
ActiveCell.Offset(0, 1).Selec
ActiveCell.Value = strSheetNam
Selection.Font.Bold = Tru
ActiveCell.Offset(1, -1).Selec

' Find out the number of columns to do
Windows(strWorkbook).Activat
Range("C2").End(xlToRight).Selec
intNbColToDo = ActiveCell.Colum

Range("C3").Selec
ActiveCell.Offset(0, 1).Selec
intNoCol = ActiveCell.Colum

Do While intNoCol < intNbColToD

Set strValidation = ActiveCell.Validatio
On Error GoTo NextCel
With strValidatio
strType = .Typ
strAlertStyle = .AlertStyl
strOperator = .Operato
strFormula1 = .Formula
strFormula2 = .Formula
strValue = .Valu
End Wit

' Return the letter(s) corresponding to th
' column number
strLetter = NbEnAA.NbEnAA(intNoCol

' Write the information
Windows("Utility.xls").Activat

ActiveCell.Value = " Col. " & strLette
ActiveCell.Offset(0, 1).Selec

ActiveCell.Value = strTyp
ActiveCell.Offset(0, 1).Selec
ActiveCell.Value = strAlertStyl
ActiveCell.Offset(0, 1).Selec
ActiveCell.Value = strOperato
ActiveCell.Offset(0, 1).Selec
ActiveCell.Value = strFormula

ActiveCell.Offset(1, -4).Selec

NextCell
Windows(strWorkbook).Activat
ActiveCell.Offset(0, 1).Selec
intNoCol = ActiveCell.Colum
Loo
Windows(strWorkbook).Activat

Next int
Windows("Utility.xls").Activat
MsgBox "Job done.
Exit Su

ErrUtilityWorksheet
Err =
MsgBox "The workbook 'Utility.xls' must be open " &
vbCrLf & vbCrLf & "and the workbook to be treated " &
"must be active.
End Su
'******************************************************************
Thank you.

 

[Dick Kusleika]

Jac

I want to know how to skip a cell that do not contain a validation

The best way is to try to access the validation and test for an error. If
you get an error, the cell doesn't have validation.

I also want to distinguish between a validation that shows a list of

values and a text length validation (the information to gather is
different).

You can use a select case to test the Type property.

Where can I get the constant names and corresponding numbers (Type

property xlValidateTextLength = 6, Operator xlLessEqual = 8, etc.)?

You can use the Object Browser (F2) and look up the constants to get their
values.

I've rewritten your code into two subs and a function. There's a lot of
selecting and activating that you really don't need. I've included comments
so you can see what I'm doing.

Sub ListValidations()

Dim sh As Worksheet
Dim cell As Range
Dim wbProcess As Workbook
Dim shUtility As Worksheet
Dim wbUtil As Workbook
Dim Rng As Range
Dim sTestValid As String
Dim lRowCnt As Long
Dim lCellCnt As Long

Const sUtilWbName As String = "Utility.xls"
Const sUtilWsName As String = "List of Values"

'Define the workbook to process
Set wbProcess = ActiveWorkbook

'Identify the output workbook
Set wbUtil = GetUtilityWorkbook(sUtilWbName)

If wbUtil Is Nothing Then
Exit Sub
Else
Set shUtility = wbUtil.Sheets(sUtilWsName)
End If

'Set the header info
With shUtility
.Range("A2:B20").ClearContents
.Range("A2").Value = wbProcess.Name
.Range("A2").Font.Bold = True
End With

'Loop through all the sheets
For Each sh In wbProcess.Worksheets

'skip the last two sheets
If Not (sh.Name = wbProcess.Sheets(wbProcess.Sheets.Count).Name Or _
sh.Name = wbProcess.Sheets(wbProcess.Sheets.Count - 1).Name)
Then

'keep track of the output row
lRowCnt = lRowCnt + 1

With shUtility.Range("A2").Offset(lRowCnt, 0)

'record the sheet number and name
.Value = sh.Index
.Offset(0, 1).Value = sh.Name
.Resize(, 2).Font.Bold = True

'set the range that may have validation
Set Rng = sh.Range("D3", sh.Range("D3").End(xlToRight))

'Loop through the cells in the range
For Each cell In Rng.Cells

'Make sure the cell as validation
On Error Resume Next
sTestValid = cell.Validation.ErrorMessage

If Err.Number = 0 Then 'cell has validation
On Error GoTo 0

'record the column
.Offset(lCellCnt, 2).Value = cell.Column

'record the validation items
RecordValidation cell, .Range("A1"), lCellCnt

'increment the column count and row count
lCellCnt = lCellCnt + 1
lRowCnt = lRowCnt + 1
End If

'clear the error (if any) and reset error handling
Err.Clear
On Error GoTo 0

Next cell
End With
End If

'Re-initialize cellcnt for next sheet
lCellCnt = 0
Next sh


End Sub


Function GetUtilityWorkbook(sName As String) As Workbook

Dim wb As Workbook
Dim sOpenName As String

On Error Resume Next
Set wb = Workbooks(sName)

If Err.Number <> 0 Then
Do
sOpenName = Application.GetOpenFilename("*.xls,(*.xls)", ,
"Find Utility.xls")
If sOpenName = "False" Then
Set GetUtilityWorkbook = Nothing
Exit Function
End If
Loop Until Right(sOpenName, Len(sName)) = sName

Set wb = Workbooks.Open(sName)
End If

Set GetUtilityWorkbook = wb

Err.Clear
On Error GoTo 0

End Function

Sub RecordValidation(ByRef rCurrent As Range, ByRef rStart As Range, ByVal
lCellCnt As Long)

With rStart
Select Case rCurrent.Validation.Type
Case xlValidateTextLength
.Offset(lCellCnt, 3).Value = "xlValidateTextLenght"
Select Case rCurrent.Validation.Operator
Case xlBetween
.Offset(lCellCnt, 5).Value = "xlBetween"
Case xlNotBetween
.Offset(lCellCnt, 5).Value = "xlNotBetween"
Case xlEqual
.Offset(lCellCnt, 5).Value = "xlEqual"
Case xlNotEqual
.Offset(lCellCnt, 5).Value = "xlNotEqual"
Case xlGreater
.Offset(lCellCnt, 5).Value = "xlGreater"
Case xlLess
.Offset(lCellCnt, 5).Value = "xlLess"
Case xlGreaterEqual
.Offset(lCellCnt, 5).Value = "xlGreaterEqual"
Case xlLessEqual
.Offset(lCellCnt, 5).Value = "xlLessEqual"
End Select
Case xlValidateList
.Offset(lCellCnt, 3).Value = "xlValidateList"
End Select

Select Case rCurrent.Validation.AlertStyle
Case xlValidAlertStop
.Offset(lCellCnt, 4).Value = "xlValidAlertStop"
Case xlValidAlertWarning
.Offset(lCellCnt, 4).Value = "xlValidAlertWarning"
Case xlValidAlertInformation
.Offset(lCellCnt, 4).Value = "xlValidAlertInformation"
End Select

.Offset(lCellCnt, 6) = "'" & rCurrent.Validation.Formula1
End With

End Sub

 

[Jac Tremblay]

Hi Dick, or whoever can answer my question
I have studied your code and found it quite professional. I thank you again for your effort to help me out
In my code, I usually activate sheets and select cells so that I can easily see what's happening in debug mode. I have used your version to create a new macro that lists all the validations' addresses in all of a workbook's sheets. My only problem now is that I do not know if it is possible to select all the cells that contain validations (or set a range that points to them) without activating the sheet itself. I tried but could not find a way. For example, i tried (I do not list all what I have tried, you may guess why...)
' ****
' Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation).Range(Cells
' sh.UsedRange.SpecialCells(xlCellTypeAllValidation).Selec
' ****
I always get an error. I had to settle temporarily for this solution that works fine
' ****
sh.Activat
On Error GoTo NextShee
ActiveCell.SpecialCells(xlCellTypeAllValidation).Selec
Set Rng = Selectio
' ****
Here is the code (one procedure and a function) written by Dick Kusleika and adapted by me
' ****
'******************************************************************
Sub ListValidationsAddresses(
' By Dick Kusleika, Excel MVP April 27, 200
' and Jac Tremblay May 7, 200
Dim sh As Workshee
Dim cell As Rang
Dim wbProcess As Workboo
Dim shUtility As Workshee
Dim wbUtil As Workboo
Dim Rng As Rang
Dim sTestValid As Strin
Dim lRowCnt As Lon
Dim lCellCnt As Lon

Const sUtilWbName As String = "Utility.xls
Const sUtilWsName As String = "Adresses des validations

'Define the workbook to proces
Set wbProcess = ActiveWorkboo

'Identify the output workboo
Set wbUtil = GetUtilityWorkbook(sUtilWbName

If wbUtil Is Nothing The
Exit Su
Els
Set shUtility = wbUtil.Sheets(sUtilWsName
End I

'Set the header inf
With shUtilit
.Range("A2:C300").Clea
.Range("A2").Value = wbProcess.Nam
.Range("A2").Font.Bold = Tru
End Wit
lRowCnt =

'Loop through all the sheet
For Each sh In wbProcess.Worksheet

'skip the last two sheet
If Not (sh.Name =
wbProcess.Sheets(wbProcess.Sheets.Count).Name Or sh.Name =
wbProcess.Sheets(wbProcess.Sheets.Count - 1).Name) The

'keep track of the output ro
' lRowCnt = lRowCnt +

With shUtility.Range("A2").Offset(lRowCnt, 0

'record the sheet number and nam
.Value = sh.Inde
.Offset(0, 1).Value = sh.Nam
.Resize(, 2).Font.Bold = Tru

'select the areas containing validations in the shee
' Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation).Range(Cells
' sh.UsedRange.SpecialCells(xlCellTypeAllValidation).Selec
sh.Activat
On Error GoTo NextShee
ActiveCell.SpecialCells(xlCellTypeAllValidation).Selec
Set Rng = Selectio

'Loop through the areas in the rang
For Each cell In Rng.Area

'Record the addres
' shUtility.Activat
.Offset(lCellCnt, 2).Value = cell.Addres

'increment the column count and row coun
lCellCnt = lCellCnt +
lRowCnt = lRowCnt +
Next cel
End Wit
End I
NextSheet
If Err.Number <> 0 The
'clear the error (if any) and reset error handlin
Err.Clea
On Error GoTo

'skip a line (this sheet had no validations
lRowCnt = lRowCnt +
End I

'Re-initialize cellcnt for next shee
lCellCnt =
Next s
End Su
'******************************************************************
Function GetUtilityWorkbook(sName As String) As Workboo
' By Dick Kusleika, Excel MVP April 27, 200

Dim wb As Workboo
Dim sOpenName As Strin

On Error Resume Next
Set wb = Workbooks(sName)
If Err.Number <> 0 Then
Do
sOpenName = Application.GetOpenFilename("*.xls," & _
"(*.xls)", , "Find Utility.xls")
If sOpenName = "False" Then
Set GetUtilityWorkbook = Nothing
Exit Function
End If
Loop Until Right(sOpenName, Len(sName)) = sName
Set wb = Workbooks.Open(sName)
End If
Set GetUtilityWorkbook = wb
Err.Clear
On Error GoTo 0
End Function
' *****
Thank you.

 

[Dick Kusleika]

Jac

You can set Rng to validation cells like this

Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation)

and then loop through the cells in Rng.

--
Dick Kusleika
MVP - Excel
Excel Blog - Daily Dose of Excel
www.dicks-blog.com

Hi Dick, or whoever can answer my question,
I have studied your code and found it quite professional. I thank you

again for your effort to help me out.

In my code, I usually activate sheets and select cells so that I can

easily see what's happening in debug mode. I have used your version to
create a new macro that lists all the validations' addresses in all of a
workbook's sheets. My only problem now is that I do not know if it is
possible to select all the cells that contain validations (or set a range
that points to them) without activating the sheet itself. I tried but could
not find a way. For example, i tried (I do not list all what I have tried,
you may guess why...):

 

[Jac Tremblay]

Hi Dick
You are right again. It works fine now. I am impressed. Here is the new version of the lines that caused my problem
' ****
'select the areas containing validations in the shee
On Error GoTo NextShee
Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation
' ****
Thank you very much for your help.