I believe the code below will do what you want.
It creates a Table of Contents worksheet.
It lists hyperlinks to each worksheet, Visible/Hidden,
Protected/Unprotected. Column D is for notes you might want to add for
descriptions of each worksheet.
Thanks for the idea! I've had this Table of Contents forever but never
thought to add the Protected/Unprotected information.

'==========================================
Public Sub Table_Of_Contents()
'Create a separate worksheet with the name of each sheet
' in the workbook as a hyperlink to that sheet -
' i.e. a TOC
'07/25/2000 - allow for chart sheets
'08/11/2005 - add Protect/Unprotect information
Dim iRow As Integer, iColumn As Integer, y As Integer
Dim i As Integer, x As Integer, iSheets As Integer
Dim objOutputArea As Object
Dim strTableName As String, strSheetName As String
Dim strOrigCalcStatus As String

strTableName = "Table_of_Contents"

'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count

'Check for duplicate Sheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Sheets(x).Name) = UCase(strTableName) Then
Sheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
'turn warning messages off
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
'turn warning messages on
Application.DisplayAlerts = True
Exit For
End If
Next

'Add new sheet at end of workbook
' where results will be located
Sheets.Add.Move Befo=Sheets(1)

'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.Name = strTableName
ActiveWorkbook.ActiveSheet.Range("A1").Value = _
"Worksheet (hyperlink)"
ActiveWorkbook.ActiveSheet.Range("B1").Value = _
"Visible / Hidden"
ActiveWorkbook.ActiveSheet.Range("C1").Value = _
"Prot / Un"
ActiveWorkbook.ActiveSheet.Range("D1").Value = _
" Notes: "

'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count

'Initialize row and column counts for putting
'info into StrTableName sheet
iRow = 1
iColumn = 0

Set objOutputArea = _
ActiveWorkbook.Sheets(strTableName).Range("A1")

'Check Sheet names
For x = 1 To iSheets
' Sheets(x).Activate
' strSheetName = ActiveSheet.Name
strSheetName = Sheets(x).Name
'put information into StrTableName worksheet
With objOutputArea
If strSheetName < strTableName Then
.Offset(iRow, iColumn) = " " & strSheetName
If UCase(TypeName(Sheets(x))) < "CHART" Then
Sheets(x).Hyperlinks.Add _
Anchor:=objOutputArea.Offset(iRow, _
iColumn), _
Address:="", SubAddress:=Chr(39) & _
strSheetName & Chr(39) & "!A1"
End If
If Sheets(x).Visible = True Then
.Offset(iRow, iColumn + 1) = " Visible"
.Offset(iRow, iColumn).Font.Bold = True
.Offset(iRow, iColumn + 1).Font.Bold = True
Else
.Offset(iRow, iColumn + 1) = " Hidden"
End If
If Sheets(x).ProtectContents = True Then
.Offset(iRow, iColumn + 2) = " P"
Else
.Offset(iRow, iColumn + 2) = " U"
End If
iRow = iRow + 1
End If
End With
Next x

Sheets(strTableName).Activate

'format worksheet
Range("A:D").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.Name = "Tahoma"
'.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
'.ColorIndex = xlAutomatic
End With

Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Font.Bold = True
Columns("A:D").EntireColumn.AutoFit

Range("A1:D1").Select
With Selection
.HorizontalAlignment = xlCenter
.Font.Underline = xlUnderlineStyleSingle
End With

Range("B1").Select
With ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Bold"
End With
With ActiveCell.Characters(Start:=8, Length:=9).Font
.FontStyle = "Regular"
End With

Columns("A:D").EntireColumn.AutoFit
Range("A1:D1").Font.Underline = _
xlUnderlineStyleSingleAccounting

Range("B:B").HorizontalAlignment = xlCenter

Range("C1").WrapText = True
Columns("C:C").HorizontalAlignment = xlCenter
Rows("1:1").RowHeight = 100
Columns("C:C").ColumnWidth = 5.15
Rows("1:1").EntireRow.AutoFit

Range("D1").HorizontalAlignment = xlLeft
Columns("D:D").ColumnWidth = 65

'format print options
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintGridlines = True
.CenterHorizontally = True
.Orientation = xlPortrait
.FirstPageNumber = xlAutomatic
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With

Range("B1").Select

Selection.AutoFilter

Application.Dialogs(xlDialogWorkbookName).Show

End Sub
'==========================================

HTH,
--
Gary Brown

If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".


"Alan P" wrote:

I have workbooks containing many protected worksheets. I would like to set
up an index page that shows the name of each worksheet and its current status
- protected or unprotected. Using the CELL function only gives the status of
a cell, does anyone know if there is an equivalent function/technique for the
entire worksheet? Thanks.