6
\$\begingroup\$

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
\$\endgroup\$
6
\$\begingroup\$

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?

\$\endgroup\$
  • 1
    \$\begingroup\$ You can make a StringBuilder though :) \$\endgroup\$ – Mathieu Guindon Mar 1 '17 at 19:18
  • \$\begingroup\$ And you can persist Application properties with a class \$\endgroup\$ – ThunderFrame Mar 1 '17 at 19:25
  • \$\begingroup\$ 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. \$\endgroup\$ – IvenBach Mar 2 '17 at 17:52
0
\$\begingroup\$

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
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.