Extract Data Validation Input Messages and Titles

D

Dodson Brown

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.
 
D

Debra Dalgleish

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

'================================
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
'======================================
 
D

Dave Peterson

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
 
D

Debra Dalgleish

Thanks Dave!

Dave said:
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
Click to expand...
 
K

keepITcool

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 :
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Extract filtered data 1
Remove Validation Input Messages 3
Transfer Data from Input Form - Offset to different worksheet 3
Excel VBA Replace Data Validation Titles and Input Messages 2
Validation on text input boxes on a form 11
Input Box data validation 7
Data Validation and a Clear Button 8
Input validation using VBA 1

Top