How can I create a table of contents(worksheets) for a large work.

[Guest]

I have a workbook with over 100 worksheets. I want to creat a table of
contents on 1 sheet to link, by name of the worksheet, instead of scrolling
the tabs. Possible?

 

[Frank Kabel]

Hi
see:
http://www.mvps.org/dmcritchie/excel/buildtoc.htm

 

[Guest]

thanks Frank:
Just noticed through a small bit of trial that I can link insert hyperlink,
then place in this document and the macro is done!

 

[Gord Dibben]

My personal preference is this code written by Bob Phillips.

Sub BrowseSheets()
Const nPerColumn As Long = 38 'number of items per column
Const nWidth As Long = 13 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___SheetGoto" 'name of dialog sheet
Const kCaption As String = " Select sheet to goto"
'dialog caption

Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton

Application.ScreenUpdating = False

If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.Name = sID
.Visible = xlSheetHidden

'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
cleft = 78
TopPos = 40

For i = 1 To ActiveWorkbook.Worksheets.Count

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cleft = cleft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.OptionButtons.Add cleft, TopPos, cLetters * nWidth, 16.5
.OptionButtons(iBooks).text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = cleft + (cMaxLetters * nWidth) + 24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeight + 10)
.Width = cleft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.OptionButtons
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets(cb.Caption).Select
Exit For
End If
Next cb
Else
MsgBox "Nothing selected"
End If

Application.DisplayAlerts = False
.Delete

End With

End Sub


Gord Dibben Excel MVP

 

[Norman Jones]

Hi Gord,

I think there is a small typo in that code::
Dim iLeft As Long should be Dim cLeft.As Long

I also like code due to Jim Rech:

Sub ShowSheetList()
On Error Resume Next
If ActiveWorkbook.Sheets.Count <= 16 Then
Application.CommandBars("Workbook Tabs").ShowPopup 500, 225
Else
Application.CommandBars("Workbook Tabs"). _
Controls("More Sheets...").Execute
End If
On Error GoTo 0
End Sub

 

[Gord Dibben]

Correct on the ileft/cleft issue, although it seems to make no difference when
the code runs??

I prefer Bob's code as the worksheets are listed on one visible "page" with
option buttons rather than a scrollable listbox.

Gord

 

[Norman Jones]

Hi Gord,

Correct on the ileft/cleft issue, although it seems to make no difference
when
the code runs??

Only if no Option Explicit statement is used. Personally, I would always
advocate the use of OE.

I prefer Bob's code ...

I too like Bob's code, especially his adroit use of a dialog sheet. My use
of Jim Rech's code is driven by habit and a penchant for using inbuilt
functionality if possible.

 

[Gord Dibben]

Norman

Right, I forgot the OE when I copied to an add-in in its own module.

Gord