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(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

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

"Mitch Matheny" wrote in message
...
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(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

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

"Don Guillett" wrote:

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

"Mitch Matheny" wrote in message
...
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(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