How do I create a macro to show/hide several worksheets in my displayed list?

[gkisystems]

I have 4 really great Macro's that I need some help tying together.

One macro looks at all the tabs in my workbook and creates an Index tab showing all the sheet names within the workbook and creates a hyperlink to each of those sheets. The macro also gives the option to add a hyperlink on each sheet to go back to the Index. This is extremely helpful to use with workbooks that have hundreds of sheets. Additionally, the macro will also tell the user on the Index tab if the sheets in the workbook are Visible, Hidden, or Very Hidden.

The next macro I have hides my active sheet. It is a lot quicker to just push a button to hide my sheet compared to right clicking on the tab and then clicking on hide. I also have a macro that does the same thing, except makes the sheet Very Hidden instead of just regular hidden.

The last macro I have makes all my sheets visible (unhides the hidden and very hidden sheets). This one is useless however if I have 30+ sheets hidden and I only want to unhide a half dozen or so.

Here is what I need help doing:

After I run CreateIndex(), I get a list of all my worksheets in column A along with the status of each (Visible, Hidden, or Very Hidden) in column B. I want to go to the Index tab and hand pick a few of the named sheets and change their status in Column B. For instance, if I have a few sheets where the status is "Hidden," I would like to type the word "Visible" for those specific sheets and then perhaps pick a few other sheets that are Visibile and make them hidden. After typing in all my changes in column B next to the Sheet names I want to change, I would like to run another macro that would then make those specific sheets visible or hidden while not affecting any of the other sheets in the process. Any help is appreciated!


Macro #1:

ub CreateIndex()
'This macro checks for an Index tab in the active worksheet and creates one if one does not already exist.
'If an Index tab already exists, the user is asked to continue.  If they continue, the original Index tab is replaced by a new Index tab.  If they do not continue, the macro stops.
'The user is then asked if they want to create a link back to the Index tab on all other worksheets (yes or no) and the macro acts accordingly.
    Dim wsIndex As Worksheet
    Dim wSheet  As Worksheet
    Dim retV    As Integer
    Dim i       As Integer
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    Set wsIndex = Worksheets.Add(Before:=Sheets(1))
    
    With wsIndex
        
        On Error Resume Next
            .Name = "Index"
            If Err.Number = 1004 Then
                If MsgBox(Prompt:="A sheet named ""Index"" already exists. Do you wish to continue by replacing it with a new Index?", _
                Buttons:=vbInformation + vbYesNo) = vbNo Then
                    .Delete
                    MsgBox "No changes were made."
                    GoTo EarlyExit:
            End If
                Sheets("Index").Delete
                .Name = "Index"
            End If
            
        On Error GoTo 0
    retV = MsgBox("Create links back to ""Index"" sheet on other sheets?", vbYesNo, "Linking Options")
    
         For Each wSheet In ActiveWorkbook.Worksheets
            If wSheet.Name <> "Index" Then
                i = i + 1
                If wSheet.Visible = xlSheetVisible Then
                    .Range("B" & i).Value = "Visible"
                ElseIf wSheet.Visible = xlSheetHidden Then
                   .Range("B" & i).Value = "Hidden"
                Else
                    .Range("B" & i).Value = "Very Hidden"
                End If
                
            .Hyperlinks.Add Anchor:=.Range("A" & i), Address:="", SubAddress:="'" & wSheet.Name & "'!A1", TextToDisplay:=wSheet.Name
            If retV = 6 And wSheet.Range("A1").Value <> "Index" Then
                wSheet.Rows(1).Insert
                wSheet.Range("A1").Hyperlinks.Add Anchor:=wSheet.Range("A1"), Address:="", SubAddress:="'" & .Name & "'!A1", TextToDisplay:=.Name
            End If
            
            End If
        Next wSheet
        
        .Rows(1).Insert
        With .Rows(1).Font
            .Bold = True
            .Underline = xlUnderlineStyleSingle
        End With
        
        .Range("A1") = "Sheet Name"
        .Range("B1") = "Status"
        .UsedRange.AutoFilter
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        Application.Goto Reference:="R1C1"
        .Columns("A:B").AutoFit
    End With
    
    With ActiveWorkbook.Sheets("Index").Tab
        .Color = 255
        .TintAndShade = 0
    End With
    
EarlyExit:
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Macro #2:

Sub HideActiveSheet()
'Hides the active tab
ActiveSheet.Visible = False
End Sub

Macro #3:

Sub HideVeryHidden()
'Hides the active tab
ActiveSheet.Visible = xlSheetVeryHidden
End Sub

Macro #4:

Sub UnhideAllSheets()
'Unhide all the sheets within the workbook.
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
End Sub

 

[Gavin T]

Hi gkisystems,

You can use this code, run the "CreateIndex" procedure to create the "Index" sheet with the button.

Sub CreateIndex()
'This macro checks for an Index tab in the active worksheet and creates one if one does not already exist.
'If an Index tab already exists, the user is asked to continue.  If they continue, the original Index tab is replaced by a new Index tab.  If they do not continue, the macro stops.
'The user is then asked if they want to create a link back to the Index tab on all other worksheets (yes or no) and the macro acts accordingly.
    Dim wsIndex As Worksheet
    Dim wSheet  As Worksheet
    Dim retV    As Integer
    Dim i       As Integer
    Dim b
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    Set wsIndex = Worksheets.Add(Before:=Sheets(1))
    
    With wsIndex
        
        On Error Resume Next
            .Name = "Index"
            If Err.Number = 1004 Then
                If MsgBox(Prompt:="A sheet named ""Index"" already exists. Do you wish to continue by replacing it with a new Index?", _
                Buttons:=vbInformation + vbYesNo) = vbNo Then
                    .Delete
                    MsgBox "No changes were made."
                    GoTo EarlyExit:
            End If
                Sheets("Index").Delete
                .Name = "Index"
            End If
            
        On Error GoTo 0
        retV = MsgBox("Create links back to ""Index"" sheet on other sheets?", vbYesNo, "Linking Options")
    
         For Each wSheet In ActiveWorkbook.Worksheets
            If wSheet.Name <> "Index" Then
                i = i + 1
                If wSheet.Visible = xlSheetVisible Then
                    .Range("B" & i).Value = "Visible"
                ElseIf wSheet.Visible = xlSheetHidden Then
                   .Range("B" & i).Value = "Hidden"
                Else
                    .Range("B" & i).Value = "Very Hidden"
                End If
                
            .Hyperlinks.Add Anchor:=.Range("A" & i), Address:="", SubAddress:="'" & wSheet.Name & "'!A1", TextToDisplay:=wSheet.Name
            If retV = 6 And wSheet.Range("A1").Value <> "Index" Then
                wSheet.Rows(1).Insert
                wSheet.Range("A1").Hyperlinks.Add Anchor:=wSheet.Range("A1"), Address:="", SubAddress:="'" & .Name & "'!A1", TextToDisplay:=.Name
            End If
            
            End If
        Next wSheet
        
        .Rows(1).Insert
        With .Rows(1).Font
            .Bold = True
            .Underline = xlUnderlineStyleSingle
        End With
        
        .Range("A1") = "Sheet Name"
        .Range("B1") = "Status"
        .UsedRange.AutoFilter
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        Application.Goto Reference:="R1C1"
        .Columns("A:B").AutoFit
    
        .Buttons.Add(200, 20, 100, 25).Select
        Selection.Characters.Text = "Apply"
        Selection.OnAction = "ApplyStatus"
    
        With .Tab
            .Color = 255
            .TintAndShade = 0
        End With
    End With
    
EarlyExit:
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Sub ApplyStatus()

    Dim rStatus  As Range
    Dim sName    As String
    Dim iLastrow As Integer
    
    iLastrow = Range("B" & Rows.Count).End(xlUp).Row

    Application.ScreenUpdating = False

    For Each rStatus In Range("B2:B" & iLastrow).Cells
        sName = rStatus.Offset(0, -1)
        Select Case rStatus
            Case "Visible"
                Sheets(sName).Visible = True
            Case "Hidden"
                Sheets(sName).Visible = False
            Case "Very Hidden"
                Sheets(sName).Visible = xlVeryHidden
        End Select
    Next rStatus
    
    Application.ScreenUpdating = True
    
End Sub

Happy Indexing!