TOC macro to skip displaying hidden sheets

[ROBJ]

Hello there,

The below code creates a table of contents in a workbook. Can hidden sheets be skipped and only the visible sheets be shown on the TOC sheet?

Appreciate your help.

Cheers

Rob


Sub TableOfContents_Create()
Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String
ContentName = "Contents"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Worksheets("Contents").Activate
On Error GoTo 0
If ActiveSheet.Name = ContentName Then
myAnswer = MsgBox("A worksheet named [" & ContentName & _
"] has already been created, would you like to replace it?", vbYesNo)
If myAnswer <> vbYes Then GoTo ExitSub
Worksheets(ContentName).Delete
End If
Worksheets.Add Before:=Worksheets(1)
Set Content_sht = ActiveSheet
With Content_sht
.Name = ContentName
.Range("B1") = "Table of Contents"
.Range("B1").Font.Bold = True
End With
ReDim myArray(1 To Worksheets.Count - 1)
For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> ContentName Then
myArray(x + 1) = sht.Name
x = x + 1
End If
Next sht
For x = LBound(myArray) To UBound(myArray)
For y = x To UBound(myArray)
If UCase(myArray(y)) < UCase(myArray(x)) Then
shtName1 = myArray(x)
shtName2 = myArray(y)
myArray(x) = shtName2
myArray(y) = shtName1
End If
Next y
Next x
For x = LBound(myArray) To UBound(myArray)
Set sht = Worksheets(myArray(x))
sht.Activate
With Content_sht
.Hyperlinks.Add .Cells(x + 2, 3), "", _
SubAddress:="'" & sht.Name & "'!A1", _
TextToDisplay:=sht.Name
.Cells(x + 2, 2).Value = x
End With
Next x
Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit
Columns("A:B").ColumnWidth = 3.86
Range("B1").Font.Size = 18
Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin
With Range("B3:B" & x + 1)
.Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
.Borders(xlInsideHorizontal).Weight = xlMedium
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(91, 155, 213)
End With
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 130
ActiveWindow.DisplayHeadings = Not ActiveWindow.DisplayHeadings
ExitSub:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[snb]

Select the text in your post; click on the # icon above the editor window.

I think this suffices:


Sub M_snb()
For Each it In Sheets
If it.Visible = -1 Then Sheet1.Hyperlinks.Add Sheet1.Cells(Sheet1.Hyperlinks.Count + 4, 1), "", "#" & it.Name & "!A1", , it.Name
Next
End Sub

[p45cal]

Change:
If sht.Name <> ContentName Then
to:
If sht.Name <> ContentName And sht.Visible = -1 Then

Add:
ReDim Preserve myArray(1 To x)
directly after:
Next sht

[Paul_Hossler]

Nothing wrong with your macro - it works

However, it seems a little overly complex, with 2 arrays, and loops, etc.

Here's a version with some (to me at least) simplifications

If you wanted to,

1. you could make hidden sheets' col B yellow, and VeryHidden sheets' col B red an still list them
2. add information about each sheet to its row starting in col D on the TOC (UsedRange, etc.)






Option Explicit

Const ContentName As String = "Contents"

Sub TableOfContents_Create()

Dim sht As Worksheet, Content_sht As Worksheet
Dim rowOut As Long

On Error Resume Next
Set Content_sht = Worksheets(ContentName)
On Error GoTo 0

If Not Content_sht Is Nothing Then
If MsgBox("A worksheet named [" & ContentName & "] has already been created, would you like to replace it?", _
vbYesNo + vbQuestion, "Create TOC Worksheet") = vbNo Then
Exit Sub
End If

Application.DisplayAlerts = False
Worksheets(ContentName).Delete
Application.DisplayAlerts = True
End If


Application.ScreenUpdating = False

Worksheets.Add Before:=Worksheets(1)
Set Content_sht = ActiveSheet

With Content_sht
.Name = ContentName
.Range("B1") = "Table of Contents"
.Range("B1").Font.Bold = True
.Range("B1").Font.Size = 18
.Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin
End With

rowOut = 3
For Each sht In ActiveWorkbook.Worksheets
If sht Is Content_sht Then GoTo NextSheet
If sht.Visible <> xlSheetVisible Then GoTo NextSheet

With Content_sht.Cells(rowOut, 2)
.Value = rowOut - 2
.Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
.Borders(xlInsideHorizontal).Weight = xlMedium
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(91, 155, 213)
End With

With Content_sht
.Hyperlinks.Add .Cells(rowOut, 3), "", _
SubAddress:="'" & sht.Name & "'!A1", _
TextToDisplay:=sht.Name
End With

rowOut = rowOut + 1
NextSheet:
Next sht

With Content_sht
.Select
.Columns("A:B").ColumnWidth = 3.86
.Columns(3).EntireColumn.AutoFit
End With


ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 130
ActiveWindow.DisplayHeadings = False

Application.ScreenUpdating = True

End Sub





I like the TOC idea so I'll probably add it to my Personal.XLSM

[ROBJ]

Thank you all. Appreciate your help.