How would I exclude hidden sheets from being created TOC

[ksebring]

Here is my code that i'm using to create a table of contents for my workbook. I have three hidden sheets and dont want them to show up on the TOC.

Sub TableOfContents_Create()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab
'SOURCE: Squarespace - Claim This Domain

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

'Inputs
ContentName = "Contents"

'Optimize Code
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
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)

'Did user select No or Cancel?
If myAnswer <> vbYes Then GoTo ExitSub

'Delete old Contents Tab
Worksheets(ContentName).Delete
End If

'Create New Contents Sheet
Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet
Set Content_sht = ActiveSheet

'Format Contents Sheet
With Content_sht
.Name = ContentName
.Range("B1") = "Projects - Public Safety Applications"
.Range("B1").Font.Bold = True
End With

'Create Array list with sheet names (excluding Contents)
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

'Alphabetize Sheet Names in Array List
For x = LBound(myArray) To UBound(myArray)
For y = x To UBound(myArray)
If UCase(myArray) < UCase(myArray(x)) Then
shtName1 = myArray(x)
shtName2 = myArray
myArray(x) = shtName2
myArray = shtName1
End If
Next y
Next x

'Create Table of Contents
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

'A Splash of Guru Formatting! [Optional]
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

'Adjust Zoom and Remove Gridlines
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 130

ExitSub:
'Optimize Code
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Thanks in advance!

 

[Snakehips]

ksebring,

Try edit this part...

For Each sht In ActiveWorkbook.WorksheetsIf sht.Name <> ContentName And sht.Visible = xlSheetVisible Then
myArray(x + 1) = sht.Name
x = x + 1
End If
Next sht

Hope that helps.

 

[ksebring]

Run-Time error '9':

Subscript out of range

Im getting an error on the following line:

'Create Table of Contents
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

 

[ksebring]

Don't get the error when I don't hide anything.

 

[Snakehips]

My fault for not seeing another relevant bit of your code. Try...

Sub TableOfContents_Create()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab
'SOURCE: Squarespace - Claim This Domain


Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long, viz as Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String


'Inputs
ContentName = "Contents"


'Optimize Code
Application.DisplayAlerts = False
Application.ScreenUpdating = False


'Delete Contents Sheet if it already exists
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)


'Did user select No or Cancel?
If myAnswer <> vbYes Then GoTo ExitSub


'Delete old Contents Tab
Worksheets(ContentName).Delete
End If


'Create New Contents Sheet
Worksheets.Add Before:=Worksheets(1)


'Set variable to Contents Sheet
Set Content_sht = ActiveSheet


'Format Contents Sheet
With Content_sht
.Name = ContentName
.Range("B1") = "Projects - Public Safety Applications"
.Range("B1").Font.Bold = True
End With


'Determine how many sheets other than Contents are visible
viz = -1
For Each sht In ActiveWorkbook.Sheets
If sht.Visible = xlSheetVisible Then viz = viz + 1
Next sht


'Create Array list with sheet names (excluding Contents)
ReDim myArray(1 To viz)


For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> ContentName And sht.Visible = xlSheetVisible Then
myArray(x + 1) = sht.Name
x = x + 1
End If
Next sht


'Alphabetize Sheet Names in Array List
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


'Create Table of Contents
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


'A Splash of Guru Formatting! [Optional]
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


'Adjust Zoom and Remove Gridlines
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 130


ExitSub:
'Optimize Code
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

 

[ksebring]

Worked amazingly.. Thank you.

1 more question... is there a way to also have a second cell referenced so it will show the sheet name and a second cell from the cell.

Currently returns the following:

1 ABCSHEET

Would like to add a second column:

1 ABCSHEET ABC Company address

hope this makes sense.

Kevin

 

[Snakehips]

Kevin,

If I understand correctly then modify this section as below.

'Create Table of Contents
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


'Add company address
.cells(x + 2, 4) = sht.Range("A2")  '*** Address from A2 in Sheet to column E (4) in Contents  ***  Edit to suit


End With
Next x


Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit
Content_sht.Columns(4).EntireColumn.AutoFit  '**** Edit 4 if not column E

Edit the source range and destination column to suit.

 

[ksebring]

Outstanding. Thank you!

 

[ksebring]

How would you format a column (7) to display percentages? Also can you apply conditional formatting on a column also?

for instance - Column 7 has a whole number listed and need to format to display percentage 1.02%

for conditional formatting - colum 8 has a text code of "g" for green need the background to be green and ;;; the text. (so only the colored background appears)

 

[Snakehips]

How would you format a column (7) to display percentages? Also can you apply conditional formatting on a column also?

for instance - Column 7 has a whole number listed and need to format to display percentage 1.02%

for conditional formatting - colum 8 has a text code of "g" for green need the background to be green and ;;; the text. (so only the colored background appears)

Kevin, got your PM. I'm not sure that I fully understand what you are asking. Maybe you can clarify.