TOC with link to fixed cell, NOT tab

G

Guest

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(Before:=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
 
B

Bernie Deitrick

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
 
G

Guest

Thanks, this is what I want.

Have a nice day

Bernie Deitrick said:
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 said:
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(Before:=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
Click to expand...
Click to expand...
 
M

Mitch Matheny

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(Before:=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 said:
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 said:
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(Before:=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
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

TOC referening a fixed cell 2
Alphabetize Tab & Toc's Hyperlink 7
Code execution is correct but generates Error :The file you aretrying to open is in a different form 3
Change tab color based on a cell value 14
Sort by column, not range 1
Ron de Bruin - Merge cells from all worksheets 0
Change macro to copy variable amount of rows instead of just 1? 14
Find sub not finding 1

Top