Following my previous question Create a table that lists macros in a workbook or worksheet Create a table that lists macros in a workbook or worksheet here's my Sub to determine worksheet visibility in a workbook. This arises from updating code that used extremely hard to understand logic and several disparate NamedRanges to subsequently hide/reveal sheets.
Following my previous question Create a table that lists macros in a workbook or worksheet here's my Sub to determine worksheet visibility in a workbook. This arises from updating code that used extremely hard to understand logic and several disparate NamedRanges to subsequently hide/reveal sheets.
Following my previous question Create a table that lists macros in a workbook or worksheet here's my Sub to determine worksheet visibility in a workbook. This arises from updating code that used extremely hard to understand logic and several disparate NamedRanges to subsequently hide/reveal sheets.
Create table that lists worksheet visibility
Following my previous question Create a table that lists macros in a workbook or worksheet here's my Sub to determine worksheet visibility in a workbook. This arises from updating code that used extremely hard to understand logic and several disparate NamedRanges to subsequently hide/reveal sheets.
- Is there a better/optimal to create a string as opposed to what I use:
join(Array(param1, param2,...,paramN), DELIMIT)? I only have brief exposure to StringBuilder Class and would like to know how best to do this.
Public Sub ListWorksheetVisibilityInActiveWORKBOOK()
Const DELIMIT As String = "|", COLSPAN As Long = 2
Dim HEADER As String
Dim inputCell As Range
Dim Rw As Long, Col As Long
Dim Ws As Worksheet
Dim ASU As Boolean
Dim TableName As String
HEADER = join(Array("SheetName", "Visibility"), DELIMIT)
On Error Resume Next 'Error handling to allow for cancelation
Set inputCell = GetInputCell("Select where you want the table to go")
If inputCell Is Nothing Then GoTo CleanExit
On Error GoTo 0 'Clear error handling
TableName = Application.InputBox("Table name", Default:="WorksheetVisibility")
If TableName = "False" Then
MsgBox "Table name not entered. No table has been created."
GoTo CleanExit
End If
'Check to avoid overwriting information below
Dim tblVisibility As Range, rngFormulas As Range, rngConstants As Range
Set tblVisibility = inputCell.Resize(ActiveWorkbook.Worksheets.count + 1, COLSPAN)
On Error Resume Next 'If no cells are found error wont cause issue
Set rngConstants = tblVisibility.SpecialCells(xlCellTypeConstants)
Set rngFormulas = tblVisibility.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0 'Clears error handling
If Not rngConstants Is Nothing Or Not rngFormulas Is Nothing Then
Dim Msg As String
Msg = "Some cells below will be overwritten. Overwrites cannot be undone..." & vbNewLine & vbNewLine & "Do you wish to proceed?"
If MsgBox(Msg, vbYesNo + vbCritical, "Your attention please!") = vbNo Then End
End If
ASU = Application.ScreenUpdating
Application.ScreenUpdating = False
inputCell.Value2 = HEADER
Rw = inputCell.row + 1
Col = inputCell.Column
Dim Value As String
For Each Ws In ActiveWorkbook.Worksheets
Value = join(Array(Ws.Name, Ws.Visible), DELIMIT)
Cells(Rw, Col).Value2 = Value
Rw = Rw + 1
Next
tblVisibility.Columns(1).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=DELIMIT
ActiveSheet.ListObjects.Add(xlSrcRange, tblVisibility, XlListObjectHasHeaders:=XlYesNoGuess.xlYes, Destination:=inputCell).Name = TableName
CleanExit:
Application.ScreenUpdating = ASU
End Sub
Private Function GetInputCell(ByVal Prompt As String) As Range
On Error GoTo ErrorHandler
Set GetInputCell = Application.InputBox(Prompt, Type:=8)
Exit Function
ErrorHandler:
MsgBox "User Cancelled"
Set GetInputCell = Nothing
End Function