Extract Data Validation Input Messages and Titles
 

I have an Excel spreadsheet with approximately 40 different data validation
input messages and titles.

The spreadsheet isn't mine, but I need to get the input messages and titles
out of it to put into another spreadsheet. I know that I can cut and paste
each one, but this is painful, given that it is going to change, possibly
often.

Can someone point at how to automate extracting the validation input
messages and titles.

Thanks.

Extract Data Validation Input Messages and Titles
 

The following code will insert a new sheet, and list the data validation
messages the

'================================
Sub GetDVNotes()
Dim rngDV As Range
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim lRow As Long
Dim cDV As Range
Set wsNew = Worksheets.Add
wsNew.Name = "Data Val Notes"
Application.EnableEvents = False
With wsNew
.Cells(1, 1).Value = "Sheet"
.Cells(1, 2).Value = "Cell"
.Cells(1, 3).Value = "Input Title"
.Cells(1, 4).Value = "Input Msg"
.Cells(1, 5).Value = "Error Title"
.Cells(1, 6).Value = "Error Msg"
End With
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
On Error Resume Next
Set rngDV = ws.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then
'do nothing
Else
For Each cDV In rngDV.Cells
With wsNew
.Cells(lRow, 1).Value = ws.Name
.Cells(lRow, 2).Value = cDV.Address
.Cells(lRow, 3).Value = cDV.Validation.InputTitle
.Cells(lRow, 4).Value = cDV.Validation.InputMessage
.Cells(lRow, 5).Value = cDV.Validation.ErrorTitle
.Cells(lRow, 6).Value = cDV.Validation.ErrorMessage
End With
lRow = lRow + 1
Next cDV
End If
Next ws
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler
End Sub
'======================================

Dodson Brown wrote:
I have an Excel spreadsheet with approximately 40 different data validation
input messages and titles.

The spreadsheet isn't mine, but I need to get the input messages and titles
out of it to put into another spreadsheet. I know that I can cut and paste
each one, but this is painful, given that it is going to change, possibly
often.

Can someone point at how to automate extracting the validation input
messages and titles.

Thanks.




--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html

Extract Data Validation Input Messages and Titles
 

I think that there is a slight bug in your code, Debra.

If I have a multisheet workbook with DV on everyother sheet, then that rngDV
doesn't get reset to nothing after it's been set to something.



Option Explicit
Sub GetDVNotes()
Dim rngDV As Range
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim lRow As Long
Dim cDV As Range
Set wsNew = Worksheets.Add
wsNew.Name = "Data Val Notes"
Application.EnableEvents = False
With wsNew
.Cells(1, 1).Value = "Sheet"
.Cells(1, 2).Value = "Cell"
.Cells(1, 3).Value = "Input Title"
.Cells(1, 4).Value = "Input Msg"
.Cells(1, 5).Value = "Error Title"
.Cells(1, 6).Value = "Error Msg"
End With
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
Set rngDV = Nothing '<-- Added
On Error Resume Next
Set rngDV = ws.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then
'do nothing
Else
For Each cDV In rngDV.Cells
With wsNew
.Cells(lRow, 1).Value = ws.Name
.Cells(lRow, 2).Value = cDV.Address
.Cells(lRow, 3).Value = cDV.Validation.InputTitle
.Cells(lRow, 4).Value = cDV.Validation.InputMessage
.Cells(lRow, 5).Value = cDV.Validation.ErrorTitle
.Cells(lRow, 6).Value = cDV.Validation.ErrorMessage
End With
lRow = lRow + 1
Next cDV
End If
Next ws
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler
End Sub

Debra Dalgleish wrote:

The following code will insert a new sheet, and list the data validation
messages the

'================================
Sub GetDVNotes()
Dim rngDV As Range
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim lRow As Long
Dim cDV As Range
Set wsNew = Worksheets.Add
wsNew.Name = "Data Val Notes"
Application.EnableEvents = False
With wsNew
.Cells(1, 1).Value = "Sheet"
.Cells(1, 2).Value = "Cell"
.Cells(1, 3).Value = "Input Title"
.Cells(1, 4).Value = "Input Msg"
.Cells(1, 5).Value = "Error Title"
.Cells(1, 6).Value = "Error Msg"
End With
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
On Error Resume Next
Set rngDV = ws.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then
'do nothing
Else
For Each cDV In rngDV.Cells
With wsNew
.Cells(lRow, 1).Value = ws.Name
.Cells(lRow, 2).Value = cDV.Address
.Cells(lRow, 3).Value = cDV.Validation.InputTitle
.Cells(lRow, 4).Value = cDV.Validation.InputMessage
.Cells(lRow, 5).Value = cDV.Validation.ErrorTitle
.Cells(lRow, 6).Value = cDV.Validation.ErrorMessage
End With
lRow = lRow + 1
Next cDV
End If
Next ws
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler
End Sub
'======================================

Dodson Brown wrote:
I have an Excel spreadsheet with approximately 40 different data validation
input messages and titles.

The spreadsheet isn't mine, but I need to get the input messages and titles
out of it to put into another spreadsheet. I know that I can cut and paste
each one, but this is painful, given that it is going to change, possibly
often.

Can someone point at how to automate extracting the validation input
messages and titles.

Thanks.



--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html

--

Dave Peterson

Extract Data Validation Input Messages and Titles
 

Thanks Dave!

Dave Peterson wrote:
I think that there is a slight bug in your code, Debra.

If I have a multisheet workbook with DV on everyother sheet, then that rngDV
doesn't get reset to nothing after it's been set to something.



Option Explicit
Sub GetDVNotes()
Dim rngDV As Range
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim lRow As Long
Dim cDV As Range
Set wsNew = Worksheets.Add
wsNew.Name = "Data Val Notes"
Application.EnableEvents = False
With wsNew
.Cells(1, 1).Value = "Sheet"
.Cells(1, 2).Value = "Cell"
.Cells(1, 3).Value = "Input Title"
.Cells(1, 4).Value = "Input Msg"
.Cells(1, 5).Value = "Error Title"
.Cells(1, 6).Value = "Error Msg"
End With
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
Set rngDV = Nothing '<-- Added
On Error Resume Next
Set rngDV = ws.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then
'do nothing
Else
For Each cDV In rngDV.Cells
With wsNew
.Cells(lRow, 1).Value = ws.Name
.Cells(lRow, 2).Value = cDV.Address
.Cells(lRow, 3).Value = cDV.Validation.InputTitle
.Cells(lRow, 4).Value = cDV.Validation.InputMessage
.Cells(lRow, 5).Value = cDV.Validation.ErrorTitle
.Cells(lRow, 6).Value = cDV.Validation.ErrorMessage
End With
lRow = lRow + 1
Next cDV
End If
Next ws
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler
End Sub

Debra Dalgleish wrote:

The following code will insert a new sheet, and list the data validation
messages the


--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html

Extract Data Validation Input Messages and Titles
 

Debra,

I've tried to embellish your idea.. by grouping similar validation
I only tested it on 1 'nasty' book and it worked ok, but no doubt
it will have some flaws in real life. apart from not handling
Specialcells max area count


Wouldnt mind some comments :)



Option Explicit

Sub DVDocumenter()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rngAll As Range
Dim rngCel As Range
Dim rngSame As Range
Dim rngDone As Range
Dim wksLOG As Worksheet
Dim lngCalc As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
lngCalc = Application.Calculation
Application.Calculation = xlCalculationManual


On Error Resume Next

Set wkb = ActiveWorkbook
Set wksLOG = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
wksLOG.Range("a1:n1") = Array("Addr", _
"Type", "IgnoreBlank", "InCellDropdown", _
"Formula1", "Operator", "Formula2", _
"ShowInput", "InputTitle", "InputMessage", _
"AlertStyle", "ShowError", "ErrorTitle", "ErrorMessage")

For Each wks In wkb.Worksheets
If wks.ProtectContents Then
wksLOG.Cells(Rows.Count, 1).End(xlUp)(2, 1) = wks.Name & _
" skipped: protected!"
Else
Set rngAll = Nothing
Set rngAll = wks.Cells.SpecialCells(xlCellTypeAllValidation)
If Not rngAll Is Nothing Then
Debug.Print " " & rngAll.Count
Set rngDone = wks.Cells(Rows.Count, Columns.Count)
For Each rngCel In rngAll
If Intersect(rngCel, rngDone) Is Nothing Then
Set rngSame = rngCel.SpecialCells(xlCellTypeSameValidation)
Call DumpDV(rngSame, wksLOG)
If rngDone.Count + rngSame.Count = rngAll.Count Then
Exit For
Else
Set rngDone = Union(rngDone, rngSame)
End If
End If
Next
End If
End If
Next
wksLOG.UsedRange.WrapText = False
wksLOG.UsedRange.EntireColumn.AutoFit
wksLOG.UsedRange.EntireRow.AutoFit
wksLOG.Range("a:a,e:e,j:j,n:n").WrapText = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = lngCalc

End Sub

Sub DumpDV(rng As Range, wks As Worksheet)
Dim dv As Validation
Dim rngA As Range
Dim sAddr As String
Set dv = rng.Cells(1).Validation
sAddr = rng.Worksheet.Name & vbLf
For Each rngA In rng.Areas
sAddr = sAddr & rngA.Address & vbLf
Next
sAddr = Left(sAddr, Len(sAddr) - 1)

With wks.Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(1, 14)
.NumberFormat = "@"
.Value = Array(sAddr, _
dv.Type, dv.IgnoreBlank, dv.InCellDropdown, _
dv.Formula1, dv.Operator, dv.Formula2, _
dv.ShowInput, dv.InputTitle, dv.InputMessage, _
dv.AlertStyle, dv.ShowError, dv.ErrorTitle, dv.ErrorMessage)
End With
End Sub





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Debra Dalgleish wrote :

Thanks Dave!

Dave Peterson wrote:
I think that there is a slight bug in your code, Debra.

If I have a multisheet workbook with DV on everyother sheet, then
that rngDV doesn't get reset to nothing after it's been set to
something.



Option Explicit
Sub GetDVNotes()
Dim rngDV As Range
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim lRow As Long
Dim cDV As Range
Set wsNew = Worksheets.Add
wsNew.Name = "Data Val Notes"
Application.EnableEvents = False
With wsNew
.Cells(1, 1).Value = "Sheet"
.Cells(1, 2).Value = "Cell"
.Cells(1, 3).Value = "Input Title"
.Cells(1, 4).Value = "Input Msg"
.Cells(1, 5).Value = "Error Title"
.Cells(1, 6).Value = "Error Msg"
End With
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
Set rngDV = Nothing '<-- Added
On Error Resume Next
Set rngDV = ws.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then
'do nothing
Else
For Each cDV In rngDV.Cells
With wsNew
.Cells(lRow, 1).Value = ws.Name
.Cells(lRow, 2).Value = cDV.Address
.Cells(lRow, 3).Value = cDV.Validation.InputTitle
.Cells(lRow, 4).Value = cDV.Validation.InputMessage
.Cells(lRow, 5).Value = cDV.Validation.ErrorTitle
.Cells(lRow, 6).Value = cDV.Validation.ErrorMessage
End With
lRow = lRow + 1
Next cDV
End If
Next ws
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler
End Sub

Debra Dalgleish wrote:

The following code will insert a new sheet, and list the data
validation messages the

Extract Data Validation Input Messages and Titles
 

There's code on my site that documents the validation types, with output
to a text file. Based on a posting by J.E. McGimpsey:

http://www.contextures.com/xlDataVal09.html

I'll take a look at your code ASAP.

keepITcool wrote:
Debra,

I've tried to embellish your idea.. by grouping similar validation
I only tested it on 1 'nasty' book and it worked ok, but no doubt
it will have some flaws in real life. apart from not handling
Specialcells max area count


Wouldnt mind some comments :)



Option Explicit

Sub DVDocumenter()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rngAll As Range
Dim rngCel As Range
Dim rngSame As Range
Dim rngDone As Range
Dim wksLOG As Worksheet
Dim lngCalc As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
lngCalc = Application.Calculation
Application.Calculation = xlCalculationManual


On Error Resume Next

Set wkb = ActiveWorkbook
Set wksLOG = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
wksLOG.Range("a1:n1") = Array("Addr", _
"Type", "IgnoreBlank", "InCellDropdown", _
"Formula1", "Operator", "Formula2", _
"ShowInput", "InputTitle", "InputMessage", _
"AlertStyle", "ShowError", "ErrorTitle", "ErrorMessage")

For Each wks In wkb.Worksheets
If wks.ProtectContents Then
wksLOG.Cells(Rows.Count, 1).End(xlUp)(2, 1) = wks.Name & _
" skipped: protected!"
Else
Set rngAll = Nothing
Set rngAll = wks.Cells.SpecialCells(xlCellTypeAllValidation)
If Not rngAll Is Nothing Then
Debug.Print " " & rngAll.Count
Set rngDone = wks.Cells(Rows.Count, Columns.Count)
For Each rngCel In rngAll
If Intersect(rngCel, rngDone) Is Nothing Then
Set rngSame = rngCel.SpecialCells(xlCellTypeSameValidation)
Call DumpDV(rngSame, wksLOG)
If rngDone.Count + rngSame.Count = rngAll.Count Then
Exit For
Else
Set rngDone = Union(rngDone, rngSame)
End If
End If
Next
End If
End If
Next
wksLOG.UsedRange.WrapText = False
wksLOG.UsedRange.EntireColumn.AutoFit
wksLOG.UsedRange.EntireRow.AutoFit
wksLOG.Range("a:a,e:e,j:j,n:n").WrapText = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = lngCalc

End Sub

Sub DumpDV(rng As Range, wks As Worksheet)
Dim dv As Validation
Dim rngA As Range
Dim sAddr As String
Set dv = rng.Cells(1).Validation
sAddr = rng.Worksheet.Name & vbLf
For Each rngA In rng.Areas
sAddr = sAddr & rngA.Address & vbLf
Next
sAddr = Left(sAddr, Len(sAddr) - 1)

With wks.Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(1, 14)
.NumberFormat = "@"
.Value = Array(sAddr, _
dv.Type, dv.IgnoreBlank, dv.InCellDropdown, _
dv.Formula1, dv.Operator, dv.Formula2, _
dv.ShowInput, dv.InputTitle, dv.InputMessage, _
dv.AlertStyle, dv.ShowError, dv.ErrorTitle, dv.ErrorMessage)
End With
End Sub





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Debra Dalgleish wrote :


Thanks Dave!

Dave Peterson wrote:

I think that there is a slight bug in your code, Debra.

If I have a multisheet workbook with DV on everyother sheet, then
that rngDV doesn't get reset to nothing after it's been set to
something.



Option Explicit
Sub GetDVNotes()
Dim rngDV As Range
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim lRow As Long
Dim cDV As Range
Set wsNew = Worksheets.Add
wsNew.Name = "Data Val Notes"
Application.EnableEvents = False
With wsNew
.Cells(1, 1).Value = "Sheet"
.Cells(1, 2).Value = "Cell"
.Cells(1, 3).Value = "Input Title"
.Cells(1, 4).Value = "Input Msg"
.Cells(1, 5).Value = "Error Title"
.Cells(1, 6).Value = "Error Msg"
End With
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
Set rngDV = Nothing '<-- Added
On Error Resume Next
Set rngDV = ws.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then
'do nothing
Else
For Each cDV In rngDV.Cells
With wsNew
.Cells(lRow, 1).Value = ws.Name
.Cells(lRow, 2).Value = cDV.Address
.Cells(lRow, 3).Value = cDV.Validation.InputTitle
.Cells(lRow, 4).Value = cDV.Validation.InputMessage
.Cells(lRow, 5).Value = cDV.Validation.ErrorTitle
.Cells(lRow, 6).Value = cDV.Validation.ErrorMessage
End With
lRow = lRow + 1
Next cDV
End If
Next ws
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler
End Sub

Debra Dalgleish wrote:


The following code will insert a new sheet, and list the data
validation messages the




--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html

Extract Data Validation Input Messages and Titles
 

Thanks for the great help!!!

D. Brown


"Debra Dalgleish" wrote in message
...
There's code on my site that documents the validation types, with output
to a text file. Based on a posting by J.E. McGimpsey:

http://www.contextures.com/xlDataVal09.html

I'll take a look at your code ASAP.

keepITcool wrote:
Debra,

I've tried to embellish your idea.. by grouping similar validation
I only tested it on 1 'nasty' book and it worked ok, but no doubt
it will have some flaws in real life. apart from not handling
Specialcells max area count


Wouldnt mind some comments :)



Option Explicit

Sub DVDocumenter()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rngAll As Range
Dim rngCel As Range
Dim rngSame As Range
Dim rngDone As Range
Dim wksLOG As Worksheet
Dim lngCalc As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
lngCalc = Application.Calculation
Application.Calculation = xlCalculationManual
On Error Resume Next

Set wkb = ActiveWorkbook
Set wksLOG = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
wksLOG.Range("a1:n1") = Array("Addr", _
"Type", "IgnoreBlank", "InCellDropdown", _
"Formula1", "Operator", "Formula2", _
"ShowInput", "InputTitle", "InputMessage", _
"AlertStyle", "ShowError", "ErrorTitle", "ErrorMessage")

For Each wks In wkb.Worksheets
If wks.ProtectContents Then
wksLOG.Cells(Rows.Count, 1).End(xlUp)(2, 1) = wks.Name & _
" skipped: protected!"
Else
Set rngAll = Nothing
Set rngAll = wks.Cells.SpecialCells(xlCellTypeAllValidation)
If Not rngAll Is Nothing Then
Debug.Print " " & rngAll.Count
Set rngDone = wks.Cells(Rows.Count, Columns.Count)
For Each rngCel In rngAll
If Intersect(rngCel, rngDone) Is Nothing Then
Set rngSame = rngCel.SpecialCells(xlCellTypeSameValidation)
Call DumpDV(rngSame, wksLOG)
If rngDone.Count + rngSame.Count = rngAll.Count Then
Exit For
Else
Set rngDone = Union(rngDone, rngSame)
End If
End If
Next
End If
End If
Next
wksLOG.UsedRange.WrapText = False
wksLOG.UsedRange.EntireColumn.AutoFit
wksLOG.UsedRange.EntireRow.AutoFit
wksLOG.Range("a:a,e:e,j:j,n:n").WrapText = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = lngCalc
End Sub

Sub DumpDV(rng As Range, wks As Worksheet)
Dim dv As Validation
Dim rngA As Range
Dim sAddr As String
Set dv = rng.Cells(1).Validation
sAddr = rng.Worksheet.Name & vbLf
For Each rngA In rng.Areas
sAddr = sAddr & rngA.Address & vbLf
Next
sAddr = Left(sAddr, Len(sAddr) - 1)

With wks.Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(1, 14)
.NumberFormat = "@"
.Value = Array(sAddr, _
dv.Type, dv.IgnoreBlank, dv.InCellDropdown, _
dv.Formula1, dv.Operator, dv.Formula2, _
dv.ShowInput, dv.InputTitle, dv.InputMessage, _
dv.AlertStyle, dv.ShowError, dv.ErrorTitle, dv.ErrorMessage)
End With
End Sub
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Debra Dalgleish wrote :


Thanks Dave!

Dave Peterson wrote:

I think that there is a slight bug in your code, Debra.

If I have a multisheet workbook with DV on everyother sheet, then
that rngDV doesn't get reset to nothing after it's been set to
something.



Option Explicit
Sub GetDVNotes()
Dim rngDV As Range
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim lRow As Long
Dim cDV As Range
Set wsNew = Worksheets.Add
wsNew.Name = "Data Val Notes"
Application.EnableEvents = False
With wsNew
.Cells(1, 1).Value = "Sheet"
.Cells(1, 2).Value = "Cell"
.Cells(1, 3).Value = "Input Title"
.Cells(1, 4).Value = "Input Msg"
.Cells(1, 5).Value = "Error Title"
.Cells(1, 6).Value = "Error Msg"
End With
lRow = 2
For Each ws In ActiveWorkbook.Worksheets
Set rngDV = Nothing '<-- Added
On Error Resume Next
Set rngDV = ws.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then
'do nothing
Else
For Each cDV In rngDV.Cells
With wsNew
.Cells(lRow, 1).Value = ws.Name
.Cells(lRow, 2).Value = cDV.Address
.Cells(lRow, 3).Value = cDV.Validation.InputTitle
.Cells(lRow, 4).Value = cDV.Validation.InputMessage
.Cells(lRow, 5).Value = cDV.Validation.ErrorTitle
.Cells(lRow, 6).Value = cDV.Validation.ErrorMessage
End With
lRow = lRow + 1
Next cDV
End If
Next ws
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler
End Sub

Debra Dalgleish wrote:


The following code will insert a new sheet, and list the data
validation messages the




--
Debra Dalgleish
Excel FAQ, Tips & Book List
http://www.contextures.com/tiptech.html