J
Jac Tremblay
Hi everyone,
I have used a macro written by Dick Kusleika, Excel MVP, as a starting point for another procedure.
I have studied his code and found it quite professional. I thank him again for his effort to help me out.
One can find the original version in a posting published on 2004-04-27 (look for Validations or my name).
In my code, I usually activate sheets and select cells so that I can easily see what's happening in debug mode. It is not the most professional way to write code, but it does the job. In an affort become profesional like him, I have used his 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 that I have tried because...):
' *****
' Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation).Range(Cells)
' sh.UsedRange.SpecialCells(xlCellTypeAllValidation).Select
' *****
No matter what I try, I always get an error. I had to settle temporarily for this solution that works fine:
' *****
sh.Activate
On Error GoTo NextSheet
ActiveCell.SpecialCells(xlCellTypeAllValidation).Select
Set Rng = Selection
' *****
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, 2004
' and Jac Tremblay May 7, 2004
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 = "Adresses des validations"
'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:C300").Clear
.Range("A2").Value = wbProcess.Name
.Range("A2").Font.Bold = True
End With
lRowCnt = 1
'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
'select the areas containing validations in the sheet
' Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation).Range(Cells)
' sh.UsedRange.SpecialCells(xlCellTypeAllValidation).Select
sh.Activate
On Error GoTo NextSheet
ActiveCell.SpecialCells(xlCellTypeAllValidation).Select
Set Rng = Selection
'Loop through the areas in the range
For Each cell In Rng.Areas
'Record the address
' shUtility.Activate
.Offset(lCellCnt, 2).Value = cell.Address
'increment the column count and row count
lCellCnt = lCellCnt + 1
lRowCnt = lRowCnt + 1
Next cell
End With
End If
NextSheet:
If Err.Number <> 0 Then
'clear the error (if any) and reset error handling
Err.Clear
On Error GoTo 0
'skip a line (this sheet had no validations)
lRowCnt = lRowCnt + 1
End If
'Re-initialize cellcnt for next sheet
lCellCnt = 0
Next sh
End Sub
'*******************************************************************
Function GetUtilityWorkbook(sName As String) As Workbook
' By Dick Kusleika, Excel MVP April 27, 2004
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
' *****
Thank you.
I have used a macro written by Dick Kusleika, Excel MVP, as a starting point for another procedure.
I have studied his code and found it quite professional. I thank him again for his effort to help me out.
One can find the original version in a posting published on 2004-04-27 (look for Validations or my name).
In my code, I usually activate sheets and select cells so that I can easily see what's happening in debug mode. It is not the most professional way to write code, but it does the job. In an affort become profesional like him, I have used his 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 that I have tried because...):
' *****
' Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation).Range(Cells)
' sh.UsedRange.SpecialCells(xlCellTypeAllValidation).Select
' *****
No matter what I try, I always get an error. I had to settle temporarily for this solution that works fine:
' *****
sh.Activate
On Error GoTo NextSheet
ActiveCell.SpecialCells(xlCellTypeAllValidation).Select
Set Rng = Selection
' *****
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, 2004
' and Jac Tremblay May 7, 2004
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 = "Adresses des validations"
'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:C300").Clear
.Range("A2").Value = wbProcess.Name
.Range("A2").Font.Bold = True
End With
lRowCnt = 1
'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
'select the areas containing validations in the sheet
' Set Rng = sh.Cells.SpecialCells(xlCellTypeAllValidation).Range(Cells)
' sh.UsedRange.SpecialCells(xlCellTypeAllValidation).Select
sh.Activate
On Error GoTo NextSheet
ActiveCell.SpecialCells(xlCellTypeAllValidation).Select
Set Rng = Selection
'Loop through the areas in the range
For Each cell In Rng.Areas
'Record the address
' shUtility.Activate
.Offset(lCellCnt, 2).Value = cell.Address
'increment the column count and row count
lCellCnt = lCellCnt + 1
lRowCnt = lRowCnt + 1
Next cell
End With
End If
NextSheet:
If Err.Number <> 0 Then
'clear the error (if any) and reset error handling
Err.Clear
On Error GoTo 0
'skip a line (this sheet had no validations)
lRowCnt = lRowCnt + 1
End If
'Re-initialize cellcnt for next sheet
lCellCnt = 0
Next sh
End Sub
'*******************************************************************
Function GetUtilityWorkbook(sName As String) As Workbook
' By Dick Kusleika, Excel MVP April 27, 2004
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
' *****
Thank you.