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

 

[gkisystems]

These two codes are really great! I took the best parts from each and combined them. The code I'm using will now ask the user to continue if the Index already exists (and replaces it with a new Index if it does, otherwise it exits the macro) and then it asks the user if he wants to add the link back to the index on each tab. I also made the Index tab the color red and frooze the top row on the Index tab.

You guys rock!

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
    
    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

 

[Gavin T]

Here's my final version it's a little different and you may prefer your own version but I like this one. Some of the benefits to using this code are:

1. Allows you to add links back to the "Index" (if you so choose)
2. More importantly eases the removal of said links by re-running and choosing no when it prompts to add links
3. Nice formatting for the "Index" tab

Sub CreateIndex()

    Dim wsIndex As Worksheet
    Dim strResp As String

    With Application
        .StatusBar = "Creating Index..."
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Set wsIndex = Worksheets.Add(Before:=Sheets(1))

    With wsIndex
        On Error Resume Next
            .Name = "Index"
            If Err.Number = 1004 Then
                strResp = MsgBox("A sheet named ""Index"" already exists." & _
                "Do you wish to continue by replacing it with a new Index?", _
                vbQuestion + vbYesNo, "Create Index")
                If strResp = vbNo Then
                    .Delete
                    MsgBox "No changes were made.", vbInformation
                    GoTo EarlyExit:
                End If
                Sheets("Index").Delete
                .Name = "Index"
            End If
        On Error GoTo 0
        
        strResp = MsgBox("Do you wish to create links back to the ""Index""?", vbQuestion + vbYesNo, "Links To Index")

        For Each wSheet In ActiveWorkbook.Worksheets
            If wSheet.Name <> .Name Then
                i = i + 1
                .Hyperlinks.Add Anchor:=.Range("A" & i), Address:="", SubAddress:="'" & wSheet.Name & "'!A1", TextToDisplay:=wSheet.Name
                With .Range("B" & i)
                    If wSheet.Visible = xlSheetVisible Then
                        .Value = "Visible"
                    ElseIf wSheet.Visible = xlSheetHidden Then
                        .Value = "Hidden"
                    Else
                        .Value = "Very Hidden"
                    End If
                End With
                If strResp = vbYes Then
                    If wSheet.Range("A1").Value <> .Name Then wSheet.Rows(1).Insert
                    wSheet.Range("A1").Hyperlinks.Add Anchor:=wSheet.Range("A1"), Address:="", SubAddress:="'" & .Name & "'!A1", TextToDisplay:=.Name
                Else
                    If wSheet.Range("A1").Value = .Name Then wSheet.Rows(1).Delete
                End If
            End If
        Next wSheet

        .Rows(1).Insert
        With .Range("A1:B1")
            .Cells(1) = "Sheet Name"
            .Cells(2) = "Status"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Interior.Color = 12632256
            .Font.Bold = True
        End With
        .Columns.AutoFit
        .UsedRange.RowHeight = 26.25
        .Tab.Color = 255
        Range(Cells(1, .UsedRange.Columns.Count + 1), Cells(1, Columns.Count)).EntireColumn.Hidden = True
        Range(Cells(.UsedRange.Rows.Count + 1, 1), Cells(Rows.Count, 1)).EntireRow.Hidden = True
    End With

EarlyExit:
    With Application
        .StatusBar = False
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub