on your main page click on the worksheet name and be taken to it

[chiefrockeruk]

i have created many worksheets in my excel workbook, my first page lists all
the worksheets and i want to be ables to click on one of the worksheet titles
in my list and be taken straight to it.

i am currentley looking at my list and then looking along the bottom for the
relavent worksheet to the list

 

[Gary Brown]

This will create a Table of Contents page with hyperlinks to each worksheet.
Hope it helps.
Sincerely,
Gary Brown


'/=============================================/
' Sub Purpose:
' Create a separate worksheet with the name of each sheet
' in the workbook as a hyperlink to that sheet -
' i.e. a Table Of Contents
' 07/25/2000 - allow for chart sheets
' 08/11/2005 - add Protect/Unprotect information
'
'
Public Sub TableOfContents()
Dim blnContinue As Boolean
Dim iRow As Integer, iColumn As Integer
Dim i As Integer, x As Integer, iSheets As Integer
Dim iType As Integer
Dim objOutputArea As Object
Dim strTableName As String, strSheetName As String
Dim strTypeName As String
Dim varAnswer As Variant

On Error GoTo err_Sub

strTableName = "Table of Contents1"
blnContinue = True

'check for an active workbook
If ActiveWorkbook Is Nothing Then
Workbooks.Add
End If

'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
blnContinue = False
Sheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
varAnswer = _
MsgBox("Do you wish to delete the current <<< " & _
strTableName & " >>> worksheet?", _
vbInformation + vbYesNoCancel + vbDefaultButton1, _
"Warning..." & strTableName & " already exists...")
If varAnswer = vbYes Then
blnContinue = True
'turn warning messages off
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
'turn warning messages on
Application.DisplayAlerts = True
End If
Exit For
End If
Next

If blnContinue = True Then
'Add new sheet at end of workbook
' where results will be located
Sheets.Add.Move Before:=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 / Tab Color"
ActiveWorkbook.ActiveSheet.Range("D1").value = _
" Notes: "
ActiveWorkbook.ActiveSheet.Range("E1").value = _
" Type: "

'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
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 Application.VERSION >= 11 Then
.Offset(iRow, iColumn + 2).Interior.ColorIndex = _
Sheets(x).Tab.ColorIndex
End If

Select Case Sheets(x).Visible
Case xlSheetVisible
.Offset(iRow, iColumn + 1) = " Visible"
.Offset(iRow, iColumn).Font.Bold = True
.Offset(iRow, iColumn + 1).Font.Bold = True
Case xlSheetHidden
.Offset(iRow, iColumn + 1) = " Hidden"
Case xlSheetVeryHidden
.Offset(iRow, iColumn + 1) = " Very Hidden"
End Select

If Sheets(x).ProtectContents = True Then
.Offset(iRow, iColumn + 2) = " P"
Else
.Offset(iRow, iColumn + 2) = " U"
End If

iType = Sheets(x).Type
strTypeName = TypeName(Sheets(x))
.Offset(iRow, iColumn + 4) = _
fncWorksheetType(iType, strTypeName)

iRow = iRow + 1

End If
End With
Next x

Sheets(strTableName).Activate

'make comment
Range("C1").AddComment

With Range("C1").Comment
.Visible = False

.Text Text:= _
"Protected / Unprotected Worksheet / Tab Color"

End With


'format worksheet
Range("A:E").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:E").EntireColumn.AutoFit

Range("A1:E1").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:E").EntireColumn.AutoFit
Range("A1:E1").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 = 9.75
Rows("1:1").EntireRow.AutoFit

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

'format print options
On Error Resume Next

Call PageSetupXL4( _
CenterHead:="&B" & "&16&U&F - [&A]", _
CenterFoot:="Page &P of &N", _
LeftMarginInches:=0.75, _
RightMarginInches:=0.75, _
TopMarginInches:=1, _
BottomMarginInches:=0.75, _
HeaderMarginInches:=0.5, _
FooterMarginInches:=0.5, _
PrintGridlines:=True, _
Orientation:=xlLandscape, _
CenterHorizontally:=True, _
Zoom:=True, _
Order:=xlOverThenDown)

With ActiveSheet.PageSetup
.PrintArea = "$A:$D"
.FitToPagesWide = 1
.FitToPagesTall = False
If .PrintTitleRows = "" Then
.PrintTitleRows = "$1:$1"
End If
If .PaperSize <> xlPaperLetter And _
.PaperSize <> xlPaperLegal Then
.PaperSize = xlPaperLetter '1
End If
End With

Range("A1").Select

Selection.AutoFilter

Application.Dialogs(xlDialogWorkbookName).Show
End If

exit_Sub:
On Error Resume Next
Application.DisplayAlerts = True
Exit Sub

err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: TableOfContents - " & _
"Module: Mod_Table_Of_Contents - " & Now()
If Err.Number = 1004 Then
MsgBox "The Workbook (" & Chr(34) & _
Application.ActiveWorkbook.name & _
Chr(34) & ") is protected. A " & _
"'Table of Contents' worksheet could not be " & _
"created. Please unprotect the " & _
"Workbook and try again.", _
vbInformation + vbOKOnly, "Warning..."
End If
If Err.Number = 438 Then
iType = 9999
Resume Next
End If
GoTo exit_Sub

End Sub
'/=============================================/
' Function Purpose: return the worksheet type
'
Public Function fncWorksheetType(iType As Integer, _
strTypeName As String) As String

Dim strResult As String

On Error GoTo err_Function

Select Case strTypeName
Case "Worksheet"
Select Case iType
Case xlWorksheet ' -4167
strResult = strTypeName
Case xlExcel4MacroSheet ' 3
strResult = "Excel4 Macro"
Case xlExcel4IntlMacroSheet ' 4
strResult = "Excel4 Intl Macro"
Case Else
strResult = "Unknown"
End Select
Case "Chart"
strResult = strTypeName
Case "DialogSheet"
strResult = strTypeName
Case Else
strResult = "Unknown"
End Select

fncWorksheetType = strResult

exit_Function:
On Error Resume Next
Exit Function

err_Function:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Function: fncWorksheetType - " & _
"Module: Mod_Table_Of_Contents - " & Now()
fncWorksheetType = "Unknown"
GoTo exit_Function

End Function
'/=============================================/

 

[Gord Dibben]

You can right-click on the navigation arrows at lower left to see a list of 15
sheets plus"more sheets".

One other method is to set up an index sheet with hyperlinks to sheets or do
what I prefer................

Use VBA code from 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 cLeft 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 MS Excel MVP