Macro to list all hidden sheets?

[gkisystems]

I have an awesome macro that creates a list of ALL worksheets (both hidden and unhidden) within my workbook on a new tab called "Index" and each worksheet listed is hyperlinked to that tab (goes to cell A1). How do I modify this macro to list in column B on the Index tab next to each sheet name the words "Hidden" or "Visible" to indiciate if the worksheet listed is hidden or visible?

Here is the macro:

Sub IDX()
'Adds a new worksheet
'Inserts all worksheet names on the new sheet
'Creates a hyperlink to cell A1 for all worksheet names.

Set newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
newsheet.Name = "Index"

Dim ws As Worksheet, i As Integer
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
Next ws

Sheets("Index").Columns("A").AutoFit

End Sub

 

[Gavin T]

How about this:

Sub IDX()
'Adds a new worksheet
'Inserts all worksheet names on the new sheet
'Creates a hyperlink to cell A1 for all worksheet names.

Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
NewSheet.Name = "Index"

Dim ws As Worksheet, i As Integer
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
[B][COLOR="#0000FF"]        If ws.Visible = xlSheetVisible Then
            Sheets("Index").Range("B" & i).Value = "Visible"
        Else
            Sheets("Index").Range("B" & i).Value = "Hidden"
        End If[/COLOR][/B]
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
Next ws

Sheets("Index").Columns("A").AutoFit

End Sub

I added the if statement colored blue.

 

[brian.wethington]

Option Explicit

Sub IDX()
'Adds a new worksheet
'Inserts all worksheet names on the new sheet
'Creates a hyperlink to cell A1 for all worksheet names.
Dim ws As Worksheet
Dim NewSheet As Worksheet
Dim i As Long

Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
NewSheet.Name = "Index"
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
        Select Case ws.Visible
            Case xlSheetHidden
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Hidden"
            Case xlSheetVeryHidden
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Very Hidden"
            Case xlSheetVisible
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Visible"
        End Select
    End If
Next ws

Sheets("Index").Columns("A").AutoFit

End Sub

 

[gkisystems]

Option Explicit

Sub IDX()
'Adds a new worksheet
'Inserts all worksheet names on the new sheet
'Creates a hyperlink to cell A1 for all worksheet names.
Dim ws As Worksheet
Dim NewSheet As Worksheet
Dim i As Long

Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
NewSheet.Name = "Index"
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
        Select Case ws.Visible
            Case xlSheetHidden
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Hidden"
            Case xlSheetVeryHidden
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Very Hidden"
            Case xlSheetVisible
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Visible"
        End Select
    End If
Next ws

Sheets("Index").Columns("A").AutoFit

End Sub

Gav & Brian - thank you very much! Both options worked!!!

I did not think to specify something for "very hidden" worksheets, so thanks for reading my mind in advance! I probably would've asked that question a few months from now if you had not anticipated it! I'm very pleased and thankful!

 

[brian.wethington]

Honestly, I don't know why I never thought of doing an Index sheet like this so I am glad to have seen this thread. I am glad I was able to give you something that works for you and I. Thanks for the feedback.

 

[gkisystems]

You're welcome! This is my personal favorite macro of all time. I put it into my personal.xlsm worksheet so that it is always available to me in Excel. Additionally, I added some code to put in a header row as well with an autofilter:

Option Explicit
Sub IDX()
'Adds a new worksheet
'Inserts all worksheet names on the new sheet
'Creates a hyperlink to cell A1 for all worksheet names.

Dim ws As Worksheet
Dim NewSheet As Worksheet
Dim i As Long

Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
NewSheet.Name = "Index"

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Index" Then
        i = i + 1
        Sheets("Index").Range("A" & i).Value = ws.Name
        Sheets("Index").Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
        Select Case ws.Visible
            Case xlSheetHidden
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Hidden"
            Case xlSheetVeryHidden
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Very Hidden"
            Case xlSheetVisible
                Sheets("Index").Range("A" & i).Offset(, 1).Value = "Visible"
        End Select
    End If
Next ws

'Insert a header row
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Application.Goto Reference:="R1C1"
    ActiveCell.FormulaR1C1 = "Sheet Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Status"
    Rows("1:1").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    Application.Goto Reference:="R1C1"
    Selection.AutoFilter

Sheets("Index").Columns("A").AutoFit
Sheets("Index").Columns("B").AutoFit

End Sub

 

[Gavin T]

I made a couple of useful improvements:

Sub CreateIndex()

    Dim wsIndex As Worksheet
    Dim wSheet  As Worksheet
    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
                MsgBox Prompt:="A sheet named ""Index"" already exist. Rename it before running again.", _
                    Buttons:=vbInformation, _
                    Title:="Name Error"
                wsIndex.Delete
                GoTo EarlyExit:
            End If
        On Error GoTo 0
    
        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
                wSheet.Rows(1).Insert
                wSheet.Range("A1").Hyperlinks.Add Anchor:=wSheet.Range("A1") _
                                                , Address:="" _
                                                , SubAddress:="'" & .Name & "'!A1" _
                                                , TextToDisplay:=.Name
            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

        .Columns("A:B").AutoFit
    End With
    
EarlyExit:
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Thanks for the code gkisystems & brian.wethington

 

[gkisystems]

So here's a question...say you add some tabs to your worksheet over time and you want to update the Index. How would you alter the above macro so that if the Index tab already exists, you delete it and replace it with a new index tab that reflects all the new worksheets just added (instead of getting an error message that the tab already exists)? Also, how would you change the above macro so that if the link to the Index tab in cell A1 is already on the other sheets within the workbook, it does NOT add another row and hyperlink to the Index tab?

Ideally, I'm wondering how to run this macro multiple times within the same workbook over time to keep the Index tab updated.

 

[brian.wethington]

My update handles this slightly differently than Gavin's update. I also added an option to add a link back to the index page if you would like. It will prompt you.

Sub CreateIndex()
Dim wsIndex As Worksheet
Dim wSheet  As Worksheet
Dim retV    As Integer
Dim I       As Integer

Application.DisplayAlerts = False
For Each wSheet In ActiveWorkbook.Worksheets
    If wSheet.Name = "Index" Then
        Set wsIndex = wSheet
        wsIndex.Cells.Delete xlUp
        If wsIndex.Index <> 1 Then wsIndex.Move before:=Sheets(1)
        Exit For
    End If
Next
If wsIndex Is Nothing Then
    Set wsIndex = Worksheets.Add(before:=Sheets(1))
    wsIndex.Name = "Index"
End If
With wsIndex
    retV = MsgBox("Create links back to ""Index"" sheet on other sheets?", vbYesNo, "Linking Options")
    For I = 2 To Worksheets.Count
        Set wSheet = Sheets(I)
        If wSheet.Index > 1 Then
            Select Case wSheet.Visible
                Case -1 ' xlSheetVisible
                    .Range("B" & I).Value = "Visible"
                Case 0 ' xlSheetHidden
                    .Range("B" & I).Value = "Hidden"
                Case 2  ' xlSheetVeryHidden
                    .Range("B" & I).Value = "V_Hidden"
            End Select
            .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
    With .Range("A1:B1")
        With .Font
            .Size = 12
            .Bold = True
        End With
    End With
    .Range("A1").Value = "NAME"
    .Range("B1").Value = "STATUS"
    .UsedRange.AutoFilter
    .Columns("A:B").AutoFit
End With
Application.DisplayAlerts = True
End Sub

 

[Gavin T]

How about this code:

Sub CreateIndex()

    Dim wsIndex As Worksheet
    Dim wSheet  As Worksheet
    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 exist. do you wish to continue anyway.", _
                Buttons:=vbInformation + vbYesNo) = vbNo Then
                    .Delete
                    GoTo EarlyExit:
                End If
                Sheets("Index").Delete
                .Name = "Index"
            End If
        On Error GoTo 0
    
        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 wSheet.Range("A1") <> .Name Then wSheet.Rows(1).Insert

                wSheet.Range("A1").Hyperlinks.Add Anchor:=wSheet.Range("A1") _
                , Address:="" _
                , SubAddress:="'" & .Name & "'!A1" _
                , TextToDisplay:=.Name
            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

        .Columns("A:B").AutoFit
    End With
    
EarlyExit:
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub