Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
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. |
#2
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
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 |
#6
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
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 |
#7
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Validation: - different messages for defined input values | Excel Discussion (Misc queries) | |||
Editing Data Validation Input Messages | Excel Discussion (Misc queries) | |||
How to extract input data? | Excel Discussion (Misc queries) | |||
Can validation input messages be locked in place? | Excel Discussion (Misc queries) | |||
Remove Data validation Input messages | Excel Programming |