TOC with link to fixed cell, NOT tab
 

Hi all

Is there a way to modify the follow code so that the title in the TOC
worksheet link to a fixed cell (eg A1) rather than the tab "name" in which
the length of wording was limited.

(the following code was from JW who had helped me in my previous ?) tnks

Sub createTOC()
Dim ws As Worksheet, wsNw As Worksheet
Dim n As Integer
Set wsNw = ActiveWorkbook.Worksheets _
.Add(Befo=ActiveWorkbook.Sheets(1))
With wsNw
starter:
On Error GoTo errHandler
.Name = "TOC"
On Error GoTo 0
.[A1] = "Table Of Contents"
.[A2] = ActiveWorkbook.Name & " Worksheets"
.[A1].Font.Size = 14
.[A2].Font.Size = 10
n = 4
For Each ws In ActiveWorkbook.Worksheets
If ws.Name < .Name And ws.Visible = True Then
.Cells(n, 1) = ws.Name
.Hyperlinks.Add _
Anchor:=.Cells(n, 1), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
n = n + 1
End If
Next
End With
Columns("A:A").EntireColumn.AutoFit
Exit Sub
errHandler: Application.DisplayAlerts = False
Sheets("TOC").Delete
Application.DisplayAlerts = True
GoTo starter
End Sub

TOC with link to fixed cell, NOT tab
 

vcff,

Change

..Cells(n, 1) = ws.Name

to

..Cells(n, 1).Formula = "='" & ws.Name & "'!A1"

which will create a link to each ws's cell A1.

HTH,
Bernie
MS Excel MVP


"vcff" wrote in message
...
Hi all

Is there a way to modify the follow code so that the title in the TOC
worksheet link to a fixed cell (eg A1) rather than the tab "name" in which
the length of wording was limited.

(the following code was from JW who had helped me in my previous ?) tnks

Sub createTOC()
Dim ws As Worksheet, wsNw As Worksheet
Dim n As Integer
Set wsNw = ActiveWorkbook.Worksheets _
.Add(Befo=ActiveWorkbook.Sheets(1))
With wsNw
starter:
On Error GoTo errHandler
.Name = "TOC"
On Error GoTo 0
.[A1] = "Table Of Contents"
.[A2] = ActiveWorkbook.Name & " Worksheets"
.[A1].Font.Size = 14
.[A2].Font.Size = 10
n = 4
For Each ws In ActiveWorkbook.Worksheets
If ws.Name < .Name And ws.Visible = True Then
.Cells(n, 1) = ws.Name
.Hyperlinks.Add _
Anchor:=.Cells(n, 1), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
n = n + 1
End If
Next
End With
Columns("A:A").EntireColumn.AutoFit
Exit Sub
errHandler: Application.DisplayAlerts = False
Sheets("TOC").Delete
Application.DisplayAlerts = True
GoTo starter
End Sub

TOC with link to fixed cell, NOT tab
 

Thanks, this is what I want.

Have a nice day

"Bernie Deitrick" wrote:

vcff,

Change

..Cells(n, 1) = ws.Name

to

..Cells(n, 1).Formula = "='" & ws.Name & "'!A1"

which will create a link to each ws's cell A1.

HTH,
Bernie
MS Excel MVP


"vcff" wrote in message
...
Hi all

Is there a way to modify the follow code so that the title in the TOC
worksheet link to a fixed cell (eg A1) rather than the tab "name" in which
the length of wording was limited.

(the following code was from JW who had helped me in my previous ?) tnks

Sub createTOC()
Dim ws As Worksheet, wsNw As Worksheet
Dim n As Integer
Set wsNw = ActiveWorkbook.Worksheets _
.Add(Befo=ActiveWorkbook.Sheets(1))
With wsNw
starter:
On Error GoTo errHandler
.Name = "TOC"
On Error GoTo 0
.[A1] = "Table Of Contents"
.[A2] = ActiveWorkbook.Name & " Worksheets"
.[A1].Font.Size = 14
.[A2].Font.Size = 10
n = 4
For Each ws In ActiveWorkbook.Worksheets
If ws.Name < .Name And ws.Visible = True Then
.Cells(n, 1) = ws.Name
.Hyperlinks.Add _
Anchor:=.Cells(n, 1), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
n = n + 1
End If
Next
End With
Columns("A:A").EntireColumn.AutoFit
Exit Sub
errHandler: Application.DisplayAlerts = False
Sheets("TOC").Delete
Application.DisplayAlerts = True
GoTo starter
End Sub

TOC with link to fixed cell, NOT tab
 

Bernie, I have been trying to add TOC code to a spreasheet that shows both a
subject field (generated by the same cell from each worksheet, not the tab
name) and a page number. The code below was copied from a post on Mr. Excel.
It provides a page number and it gives three options to populate the subject
field of the TOC. One is to display the Tab name, which works fine. Second is
to display the value from a specific cell (this is the one I cannot get to
work and would like to use), the third option uses a header field to populate
the TOC (I have not tried this option because I am not interested in it).

Could you show me what I need to do to the code below or provide other code
that will solve the issue. I appreciate any help you can provide. Thanks,

Sub CreateTableOfContents()
' Copyright 2002 MrExcel.com
' Determine if there is already a Table of Contents
' Assume it is there, and if it is not, it will raise an error
' if the Err system variable is 0, you know the sheet is not there
Dim WST As Worksheet
On Error Resume Next
Set WST = Worksheets("Table of Contents")
If Not Err = 0 Then
' The Table of contents doesn't exist. Add it
Set WST = Worksheets.Add(Befo=Worksheets(1))
WST.Name = "TOC"
End If
On Error GoTo 0

' Set up the table of contents page
WST.[A2] = "Table of Contents"
With WST.[A6]
.CurrentRegion.Clear
.Value = "Subject"
End With
WST.[B6] = "Page(s)"
WST.Range("A1:B1").ColumnWidth = Array(36, 12)
TOCRow = 7
PageCount = 0
' Do a print preview on all sheets so Excel calcs page breaks
' The user must manually close the PrintPreview window
Msg = "Excel needs to do a print preview to calculate the number of
pages. "
Msg = Msg & "Please dismiss the print preview by clicking close."
MsgBox Msg
ActiveWindow.SelectedSheets.PrintPreview
' Loop through each sheet, collecting TOC information
' Loop through each sheet, collecting TOC information
For Each S In Worksheets
If S.Visible = -1 Then
S.Select
' Use any one of the following 3 lines
'ThisName = ActiveSheet.Name
ThisName = Range("A1").Value
'ThisName = ActiveSheet.PageSetup.LeftHeader
HPages = ActiveSheet.HPageBreaks.Count + 1
VPages = ActiveSheet.VPageBreaks.Count + 1
ThisPages = HPages * VPages
' Enter info about this sheet on TOC
Sheets("TOC").Select
Range("A" & TOCRow).Value = ThisName
Range("B" & TOCRow).NumberFormat = "@"
If ThisPages = 1 Then
Range("B" & TOCRow).Value = PageCount + 1 & " "
Else
Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount +
ThisPages
End If
PageCount = PageCount + ThisPages
TOCRow = TOCRow + 1
End If
Next S
End Sub

"Bernie Deitrick" wrote:

vcff,

Change

..Cells(n, 1) = ws.Name

to

..Cells(n, 1).Formula = "='" & ws.Name & "'!A1"

which will create a link to each ws's cell A1.

HTH,
Bernie
MS Excel MVP


"vcff" wrote in message
...
Hi all

Is there a way to modify the follow code so that the title in the TOC
worksheet link to a fixed cell (eg A1) rather than the tab "name" in which
the length of wording was limited.

(the following code was from JW who had helped me in my previous ?) tnks

Sub createTOC()
Dim ws As Worksheet, wsNw As Worksheet
Dim n As Integer
Set wsNw = ActiveWorkbook.Worksheets _
.Add(Befo=ActiveWorkbook.Sheets(1))
With wsNw
starter:
On Error GoTo errHandler
.Name = "TOC"
On Error GoTo 0
.[A1] = "Table Of Contents"
.[A2] = ActiveWorkbook.Name & " Worksheets"
.[A1].Font.Size = 14
.[A2].Font.Size = 10
n = 4
For Each ws In ActiveWorkbook.Worksheets
If ws.Name < .Name And ws.Visible = True Then
.Cells(n, 1) = ws.Name
.Hyperlinks.Add _
Anchor:=.Cells(n, 1), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
n = n + 1
End If
Next
End With
Columns("A:A").EntireColumn.AutoFit
Exit Sub
errHandler: Application.DisplayAlerts = False
Sheets("TOC").Delete
Application.DisplayAlerts = True
GoTo starter
End Sub