TOC referening a fixed cell

M

Mitch Matheny

I am using Excel 200.
I have been trying to add Table of Contents (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 someone 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
 
D

Don Guillett

How about something simple

Sub tocONEcell()
For I = 1 To Worksheets.Count
Cells(I, "a") = Sheets(I).Range("a1")
Next I
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Mitch Matheny said:
I am using Excel 200.
I have been trying to add Table of Contents (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 someone 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
Click to expand...
 
M

Mitch Matheny

This worked well in conjunction with the original code. Thanks Don!

Don Guillett said:
How about something simple

Sub tocONEcell()
For I = 1 To Worksheets.Count
Cells(I, "a") = Sheets(I).Range("a1")
Next I
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Mitch Matheny said:
I am using Excel 200.
I have been trying to add Table of Contents (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 someone 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
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

VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
VBA Coding Help for Beginner 0
Remove Identical words 0
TOC with link to fixed cell, NOT tab 3
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
TOC page numbers bold 4
TOC: the first page number of each worksheet 1
sum of a named range with values based on vlookup results 20

Top