Create table that lists worksheet visibility

Question

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

Answer 1

I don't think there is a StringBuilder() class in VBA, only some tricks using Mid.

Const DELIMIT As String = "|", COLSPAN As Long = 2
Dim HEADER As String

This is a little confusing, UPPERCASE should indicate a constant, which is does with DELIMIT - but Header is not (cannot) be a constant. And that leaves me without a Dim or a Const for COLSPAN. Try to be a little more consistent with that - it will be much easier to tell what variables are what.

Dim ASU as Boolean
ASU = Application.ScreenUpdating
Application.ScreenUpdating = False
Application.ScreenUpdating = ASU

Now, I know ASU can't be a constant. Maybe screenIsUpdating? But then again, I think using a variable to store this is overkill unless you are trying to save the settings of the user - which you aren't

Dim screenIsUpdating as Boolean
screenIsUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
Application.ScreenUpdating = screenIsUpdating

This way you store the user's settings, but still turn it off for your procedure.

These variables could use better names, even if i and j -

Dim Rw As Long, Col As Long
Dim Ws As Worksheet

Ws works, but I don't recommend it, it will start to look pretty messy once you have a lot going on. Also, local variables should start with a lowercase letter Standard VBA naming conventions.

Dim tblVisibility As Range, rngFormulas As Range, rngConstants As Range

I see tblVisibility and think "oh, must be a boolean" - but it's a range. And rngFormulas and rngConstants seem to have the same issue, which is why they are prefixed with rng - yeah?

tableRange
formulaRange
constantRange

But, what is constantRange? If it's constant, it doesn't need a range.

Cells(Rw, Col).Value2 = Value

You did a good job qualifying most things, but this Cells isn't qualified - it should be inputCell.Parent.Cells - or just give that target sheet a variable.

If MsgBox(Msg, vbYesNo + vbCritical, "Your attention please!") = vbNo Then End

Here's an End again, try to avoid those. Also I think Msg (as well as some other fixed strings) could be a Const.

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

This loop is pretty confusing to me. You are iterating up the rows, but have a loop for the sheets?

For index = 1 to Thisworkbook.Worksheets.Count
 targetSheet.Cells(index+1,tableColumn) = Join(Array(Worksheets(index).Name,Worksheets.Visible), DELIMITER)
Next

But, for that Join string, I would probably do it a different way -

Dim index As Long
Dim tableArray() As String
Dim sheetCount As Long
sheetCount = ThisWorkbook.Worksheets.Count
ReDim tableArray(1 To sheetCount, 1 To 2)
For index = LBound(tableArray) To UBound(tableArray)
 tableArray(index, 1) = ThisWorkbook.Worksheets(index).Name
 tableArray(index, 2) = ThisWorkbook.Worksheets(index).Visible
Next

Arrays are faster and you can just Transpose it into your table range. Or maybe just convert the array into a table.

Oh, and your procedure name

Public Sub ListWorksheetVisibilityInActiveWORKBOOK()

Good job on being descriptive, but it's a bit much. CreateSheetVisibilityTable() maybe?

• Mathieu Guindon: You can make a StringBuilder though :)
• ThunderFrame: And you can persist Application properties with a class
• IvenBach: Working on getting consistent naming. ASU is/was my shorthand for Application.ScreenUpdating. It's meant to turn it off for the procedure and turn it back on via the variable since it may have been turned on or off prior and I can't be sure which it will be at run-time. rngConstants and rngFormulas are checking for any values that may be overwritten when the table is created. Good catch on Cells. The loop is for writing the information to the table.

Answer 2

Below is my updated code per @Raystafarian's suggestions. There is no longer any hard End and feel like it's in a better spot now.

Is there a better method of coercing the -1 results from the visibility field in the table instead of Copy/PasteSpecialing onto itself?

Public Sub CreateSheetVisibilityTable()
 Dim screenIsUpdating As Boolean
 screenIsUpdating = Application.ScreenUpdating
 On Error Resume Next 'Error handling to allow for cancelation
 Dim inputCell As Range
 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
 Dim tableName As String
 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
 Dim theWorkbook As Workbook
 Set theWorkbook = ActiveWorkbook
 Dim sheetCount As Long
 sheetCount = theWorkbook.Worksheets.count
 Dim visibilityTable As Range
 Set visibilityTable = inputCell.Resize(sheetCount + 1, 2)
 'Check to avoid overwriting information below
 On Error Resume Next 'If no cells are found error wont cause issue
 Dim rangeContainingConstants As Range
 Set rangeContainingConstants = visibilityTable.SpecialCells(xlCellTypeConstants)
 Dim rangeContainingFormulas As Range
 Set rangeContainingFormulas = visibilityTable.SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0 'Clears error handling
 If Not rangeContainingConstants Is Nothing Or Not rangeContainingFormulas Is Nothing Then
 Const Msg As String = "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 GoTo CleanExit
 End If
 Application.ScreenUpdating = False
 Dim tableArray() As String
 ReDim tableArray(0 To sheetCount, 0 To 1)
 tableArray(LBound(tableArray), 0) = "SheetName"
 tableArray(LBound(tableArray), 1) = "Visibility"
 Dim theIndex As Long
 For theIndex = LBound(tableArray) + 1 To UBound(tableArray)
 tableArray(theIndex, 0) = theWorkbook.Worksheets(theIndex).Name
 tableArray(theIndex, 1) = theWorkbook.Worksheets(theIndex).Visible
 Next
 visibilityTable.Value2 = tableArray
 inputCell.Parent.ListObjects.Add(xlSrcRange, visibilityTable, XlListObjectHasHeaders:=xlYes).Name = tableName
 'Coerce to numeric
 With inputCell.Parent.ListObjects.Item(tableName).DataBodyRange.Columns(2)
 .Copy
 .PasteSpecial Operation:=xlPasteSpecialOperationMultiply
 End With
 Application.CutCopyMode = False
CleanExit:
 Application.ScreenUpdating = screenIsUpdating
End Sub