Code to hide unhide sheets crashing Excel workbook

Question

I have code meant to list hidden worksheets, unhide them, remove a password, list workbooks that the file is linked to, refresh a power query data connection, re-apply the password, and hide previously hidden sheets as well as any sheets that are colored green on workbook open.

It causes Excel to crash. I tried modifying the code numerous times, removing the code from the workbook, saving the workbook as .XLS then re-opening, adding the code back in and re-saving as .XLSM.

Any suggestions why this may be happening or how I can improve the code to prevent Excel from crashing?

Private Sub Workbook_Open()
'Place in ThisWorkbook to run code on Workbook_Open
'Ensure that Consolidated - Query does NOT have Background Refresh Enabled in Query Properties
    Dim x As Long
    Dim shtCnt As Integer
    shtCnt = ThisWorkbook.Sheets.Count

    Application.StatusBar = "Setting up for volume refresh..."
    Application.Calculation = xlCalculationManual
    Sheets("Control").Visible = True
    Sheets("Control").Activate
    ActiveSheet.Unprotect Password:="passwordhere"
    Sheets("Control").Select

    'clear out old list
    Sheets("Control").Range("T7").Value = "Hidden Worksheets:"
    Range("T7").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = True
    Range("T8:T5000").Select
    Selection.Clear

    'list hidden sheets
    On Error Resume Next
    x = 8
    For i = 1 To shtCnt
        If Sheets(i).Visible = xlSheetHidden Then
            Cells(x, 20) = Sheets(i).Name
            x = x + 1
        End If
    Next i

    'unhide hidden sheets
    stp = Worksheets("Control").Range("T8:T5000").Cells.SpecialCells(xlCellTypeConstants).Count
    y = 8
    For j = 1 To stp
        Sheets(Cells(y, 20).Value).Visible = True
        y = y + 1
    Next j
            
        For i = 1 To Sheets.Count
          With Sheets(i)
            .Unprotect Password:="password"
            .Outline.ShowLevels RowLevels:=1
          End With
        Next i

    'list linked workbooks path
    Application.StatusBar = "Refreshing volume..."
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Sheets("Control").Range("T4").Activate
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
      xIndex = 4
      For Each link In wb.LinkSources(xlExcelLinks)
        If Not link Like "*Corporate Guidelines Master.xlsm" Then
            Application.ActiveSheet.Cells(xIndex, 20).Value = link
            xIndex = xIndex + 1
        End If
      Next link
    End If
            
    'refresh volume query
    Application.Calculation = xlCalculationAutomatic
    ThisWorkbook.Connections("Query - Consolidated").Refresh
    Application.Wait (Now + TimeValue("0:00:02"))
    DoEvents
    Application.StatusBar = "Please wait..."
        
    For i = 1 To Sheets.Count
        With Sheets(i)
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True _
        , Password:="passwordhere"
        .Select
        Cells(ThisWindow.SplitRow + 1, ThisWindow.SplitColumn + 1).Select
        End With
    Next i
                    
    'hide originally hidden sheets
    Dim tc As Object
    For Each tc In ThisWorkbook.Sheets
        If tc.Tab.Color = 4697456 Then
            tc.Visible = xlSheetHidden
        End If
    Next tc
    
    stpend = Worksheets("Control").Range("T8:T5000").Cells.SpecialCells(xlCellTypeConstants).Count
    Z = 8
    Sheets("Control").Range("T8").Select
    For k = 1 To stpend
        Sheets(Cells(Z, 20).Value).Visible = False
        Z = Z + 1
    Next k

    'close out
    Sheets("Control").Visible = False
    Sheets("Plant Summary Graphs").Select
    Range("A1").Activate
    Application.StatusBar = False
End
End Sub

Remove that On Error Resume Next and see if any error came out. — Raymond Wu
– Raymond Wu, Commented Sep 28, 2021 at 5:10
Does it crash Excel if you step through the code, if so where does it crash it? — ACCtionMan
– ACCtionMan, Commented Sep 28, 2021 at 5:34
After removing on error resum next as Raymond suggests, I would create subs for each task (unhiding/unprotecting the sheets, listing linked workbook paths etc.). Than you can test each routine itself it it's the part that leads to the crash. In the end you will have a main sub calling one task after the other. — Ike
– Ike, Commented Sep 28, 2021 at 6:06
Regarding your steps to find and unhide/unprotect the sheets - you can do this in one step once you are referencing the sheet - no need for three different loops — Ike
– Ike, Commented Sep 28, 2021 at 6:10
If you absolutely need On Error Resume Next to be there you should put On Error Goto 0 after the part you need to skip error checking — tnavidi
– tnavidi, Commented Sep 28, 2021 at 8:07

monica · Accepted Answer · 2021-10-08 21:11:29Z

Thank you, everyone, for the advice!

An issue was in the case that no worksheets were hidden when the workbook was last closed and then re-opened. So, I modified the hide/unhide sheets code:

'unhide hidden sheets
    On Error Resume Next
    stp = Worksheets("Control").Range("T8:T5000").Cells.SpecialCells(xlCellTypeConstants).Count
    On Error GoTo 0

    If stp <> "" Then
        y = 8
        For j = 1 To stp
            Sheets(Cells(y, 20).Value).Visible = True
            y = y + 1
        Next j
    End If

Hopefully this won't bug out on me going forward.

Thank you, all!

EDIT

I had to modify the following when hiding the originally hidden sheets:

On Error Resume Next
stpend = Application.WorksheetFunction.CountA(Worksheets("Control").Range("T8:T5000"))
On Error GoTo 0

If stpend <> "" Then
    Z = 8
    Sheets("Control").Select
    Range("T8").Select
    For k = 1 To stpend
        Sheets(Cells(Z, 20).Value).Visible = False
        Z = Z + 1
    Next k
End If

Collectives™ on Stack Overflow

Code to hide unhide sheets crashing Excel workbook

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related