Build TOC Another Approach

Location: http://www.mvps.org/dmcritchie/excel/buildtoc2.htm      
Home page: http://www.mvps.org/dmcritchie/excel/excel.htm
[View without Frames]
This page demonstrates how to create a summary sheet for a workbook, where all the sheets have exactly the same format.  The macro to populate this will ignore sheetnames with a space in position 2 of the sheetname.  The Summary sheet described here might be named "# Summary #".

This page is not concerned with Hyperlinks, if you want a Table of Contents with hyperlinks then see my original page Build Table of Contents with BuildTOC dealing with creating a Table of Contents with hyperlinks, and with making, revealing, and destroying Hyperlinks.  Extra code/column added to be able to sort sheetnames with numbers numerically (up to 5 digits) per internal number, so that sheet19 really does appear before sheet2 in the listing.

Sample of a Table of Contents -- Summary

 ABCDEF
1SHEET NAMECompany: Widgets
(144 per box)
Attachment A Attachment BQuotation Date
2   (source of title) B4 B5 D5 D6 D11
3   (source of data) C4 C5 E5 E6 E11
4ACMEAcme Wholesales 31.45 5.00 6.50 04/10/2001
5BraxtonBraxton Shipping 29.98 5.00 6.75 04/10/2001
6Cornell Cornell Hardware Stores 39.65 5.00 8.00 04/15/2001
Once your table is created, don't touch lines 1-4 except to insert columns.  Rows 2 & 3 determine source of data.  Row 4 contains critical formulas that will be copied by macro used to pull in sheetnames.  Once populated it is safe to sort Rows 4 down by any column -- just never delete row 4 because it is essential in locating column titles and data source, along with rows 2 & 3.

If you want essentially the same effect as this without specifying the cells on the worksheet, you can create your own macro based on BuildSheetList_Example in code/addsheets.txt, as written the example creates a list of sheetnames, with a hyperlink and value of cell A1 to the right of the sheetname.  Includes extra code to avoid showing a zero for hyperlink if the hyperlinked cell is empty.

Formulas used

 ABC
1SHEET NAME =INDIRECT($A$4&"!"&B$2)=INDIRECT($A$4&"!"&C$2)
2(source of title) B4B5
3(source of data) C4C5
4ACME =IF($A4="","",INDIRECT($A4&"!"&B$3)) =IF($A4="","",INDIRECT($A4&"!"&C$3))
5Braxton =IF($A5="","",INDIRECT($A5&"!"&B$3)) =IF($A5="","",INDIRECT($A5&"!"&C$3))
6Cornell =IF($A6="","",INDIRECT($A6&"!"&B$3)) =IF($A6="","",INDIRECT($A6&"!"&C$3))
=HYPERLINK("#'ACME'!a1","ACME")   would provide a hyperlink to the ACME worksheet with details
This Example is built with only the names of the sheets being entered by the macro.  The rest is done by placing the formula in cell B4 and then using the fill handle identified by the little bulge on the right side of the selected cell(s), and dragging it across to F4 and then grab the fill handle and drag downward as far as necessary.&nbps; Instead of dragging down you can probably double-click on the fill handle and it will propagate as long as there is an entry to the left.

This was just an example to show how you simply specify a little bit of information in Column A and in row 3 and the sheet generates all of the content for you.  You can do a little tidier job but one that might require more maintenance and where what is being done is not as obvious to people reading your sheets by coding each formula in row 4 with the actual address to be used on each sheet with specific formulas like:
   B4:  =IF($A4="","",INDIRECT($A4&"!$C$4"))
   F4:  =IF($A4="","",INDIRECT($A4&"!$E$11"))
and then propagating down using the fill handle.  For practical use being able to show eactly where the data came from may be very relevant.

Providing for references to workbook and sheetname specified in another cell (#indirect)

These formulas provide for space characters within the sheetname; whereas, the examples in the chart would never have spaces for the sheetnames.

supply single quotes in the formula (formulas not related to table above)
B7:  [file.xls]Menu Sheet
C7:  =IF(B7="","",INDIRECT("'" & B7&"'!A1"))

bring your own single quotes with cell references outside the formula (formulas not related to table above)
D7:  ''[file.xls]Menu Sheet'   -- two single quotes in front to indicate text
E7:  =IF(D7="","",INDIRECT(D7&"!A1"))
 

 AB
27 Detail 2 A3  Fill Down/Across
28 soup-mix   ='Detail 2'!A3 sheetname is static
29 soup-mix   =INDIRECT("'" & A27 & "'!A3") Cell address is static
30 soup-mix   =INDIRECT("'"&A27&"'!"&CELL("address",A3))  fill down cell on other sheet
31 soup-mix   =INDIRECT("'" & A27 & "'!" & B27)  fill down cell ref this sheet
32  soup-mix   =HYPERLINK("#'Detail 2'!" & CELL("address",A3), 'Detail 2'!A3)  sheetname is static
33  soup-mix   =HYPERLINK("#'"&A27&"'!A3",INDIRECT("'"&A27&"'!A3"))  Cell address is static
34  soup-mix   =HYPERLINK("#'"&A27&"'!" &CELL("address",A3),INDIRECT("'"&A27&"'!" & CELL("address",A3)))  fill down cell on other sheet
35  soup-mix   =HYPERLINK("#'"&A27&"'!" & B27,INDIRECT("'"&A27&"'!" & B27))  fill down cell ref this sheet
      You can use a HYPERLINK Worksheet Formula
            =HYPERLINK("#autodates!" & CELL("address",a1),autodates!A1)
            =HYPERLINK("#'menu sheet'!" & CELL("address",a1),'Menu Sheet'!A1)

Preliminaries - some simpler macros, no sorting of sheetnames (#simplemacros)

Instructions to install and use a macro can be found on my Getting Started with Macros page.

List names of sheets down from active cell (#sheetnamesdownrows)

Sub SheetNamesDownRows()
  Dim iSheet As Long
  For iSheet = 1 To ActiveWorkbook.WorkSheets.Count
    ActiveCell.offset(iSheet - 1,0) = "'" & WorkSheets(iSheet).Name
  Next iSheet
End Sub

List names of sheets across top (#SheetNamesAcrossTop)

List names of sheets across top from cell B1 to IV1.  Since there from cell B1 to IV1.  Since there are only 256 columns, this will fail after 255 sheets.
Sub SheetNamesAcrossTop()
  Dim iSheet As Long  
  For iSheet = 1 To ActiveWorkbook.WorkSheets.Count
    Range("B1").offset(0,iSheet - 1) = "'" & WorkSheets(iSheet).Name
  Next iSheet
End Sub

Simple macro to populate with Sheetnames with a Sort (#SheetNamesSortedDownRows)

Adding extra code to turn off Screen updating and Calculation to improve performance, and to sort the results.  Note the Range is reset with an offset instead of using a variable as in previous example.
Sub SheetNamesSortedDownRows()
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
    Dim Rng As Range
    Dim WS As Worksheet
    Set Rng = Range("A1")
    For Each WS In ActiveWorkbook.Worksheets
        Rng.Value = "'" & WS.Name
        Set Rng = Rng(2, 1)
    Next WS
    Cells.Sort Key1:=Range("A1"), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
    Range("A1").Select
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 
End Sub
For an example with header rows see Enumerate_sheets below.  For a much more robust soution see buildtoc2.htm.

Macro to supply sheetnames and copy formulas and formatting from Row 4

This page contains VBA macros.  Assistance to Install a Macro or User Defined Function  is on my Formula page.

The macro TOC_SheetNamesDownFromA4 is a little rough as it is being essentially run in two parts once to count sheets involved and once to populate.

Option Explicit
'David McRitchie -- Sort Sheets  and name sheets for Table of Contents "

' This is the construction of the worksheet formulas on the TOC
' B1  =INDIRECT($A$4&"!"&B$2)
' B2  'B4     -- cell for description for sheet at $A4
' b3  'C4     -- cell for value for sheet at $A4
' B4  =IF($A4="","",INDIRECT($A4&"!"&B$3))
' B5  =IF($A5="","",INDIRECT($A5&"!"&B$3))
' B6  =IF($A6="","",INDIRECT($A6&"!"&B$3))
' B7  =IF($A7="","",INDIRECT($A7&"!"&B$3))
' B8  =IF($A8="","",INDIRECT($A8&"!"&B$3))
' B9  =IF($A9="","",INDIRECT($A9&"!"&B$3))

Sub TOC_SheetNamesDownFromA4()
  'David McRitchie -- Supply Worksheetnames for Table of Contents "
  'http://www.mvps.org/dmcritchie/excel/buildtoc2.htm

  Application.Run "SortALLSheets"

  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False

  Dim iSheet As Long
  Dim iRow As Long
  iRow = 3
  For iSheet = 1 To ActiveWorkbook.Worksheets.Count
    If Mid(ActiveWorkbook.Worksheets(iSheet).Name & "  ", 2, 1) <> " " Then
       iRow = iRow + 1
       Cells(iRow, 1) = "'" & Worksheets(iSheet).Name
    End If
  Next iSheet
  'Use formats & formulas entered on Row(4)
  Rows("4:4").Select
  Selection.Copy
  Rows("5:" & iRow).Select
  Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
     False, Transpose:=False
  Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
     False, Transpose:=False
  Application.CutCopyMode = False
  iRow = 3
  For iSheet = 1 To ActiveWorkbook.Worksheets.Count
    If Mid(ActiveWorkbook.Worksheets(iSheet).Name & "  ", 2, 1) <> " " Then
       iRow = iRow + 1
       Cells(iRow, 1) = "'" & Worksheets(iSheet).Name
    End If
  Next iSheet

  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub   '-- TOC_SheetNamesDownFromA4

'=============  additional macros, of interest ============. (#SortAllSheets)

Sub SortALLSheets()
  'modification of coded example by Bill Manville
  Dim iSheet As Long, iBefore As Long
  For iSheet = 1 To ActiveWorkbook.Sheets.Count
    Sheets(iSheet).Visible = True
    For iBefore = 1 To iSheet - 1
      If UCase(Sheets(iBefore).Name) > UCase(Sheets(iSheet).Name) Then
        ActiveWorkbook.Sheets(iSheet).Move Before:=ActiveWorkbook.Sheets(iBefore)
        Exit For
      End If
    Next iBefore
  Next iSheet
End Sub   '-- SortALLSheets()

Sub makelastcell()
  'David McRitchie,  http://www.mvps.org/dmcritchie/excel/lastcell.htm
  Dim x As Long     'revised 2001-08-09 to remove false indication
  Dim str As String
  Dim xLong As Long, clong As Long, rlong As Long
  On Error GoTo 0
  x = MsgBox("Do you want the activecell to become " & _
      "the lastcell" & Chr(10) & Chr(10) & _
      "Press OK to Eliminate all cells beyond " _
      & ActiveCell.Address(0, 0) & Chr(10) & _
      "Press CANCEL to leave sheet as it is", _
      vbOKCancel + vbCritical + vbDefaultButton2)
  If x = vbCancel Then Exit Sub
  str = ActiveCell.Address
  Range(ActiveCell.Row + 1 & ":" & Cells.Rows.Count).Delete
  xLong = ActiveSheet.UsedRange.Rows.Count   'see J-Walkenbach tip 73
  xLong = ActiveSheet.UsedRange.Columns.Count 'might also help
  'use of filters can interfer with column elimination
  Range(Cells(1, ActiveCell.Column + 1), _
     Cells(Cells.Rows.Count, Cells.Columns.Count)).Delete
  Beep
  xLong = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Columns.Count 'Tip73
  rlong = Cells.SpecialCells(xlLastCell).Row
  clong = Cells.SpecialCells(xlLastCell).Column
  If rlong <= ActiveCell.Row And clong <= ActiveCell.Column Then Exit Sub
  ActiveWorkbook.Save
  xLong = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Columns.Count 'Tip73
  rlong = Cells.SpecialCells(xlLastCell).Row
  clong = Cells.SpecialCells(xlLastCell).Column
  If rlong <= ActiveCell.Row And clong <= ActiveCell.Column Then Exit Sub
  MsgBox "Sorry, Have failed to make " & str & " your last cell"
End Sub     ' -- MakeLastCell()

Sub Enumerate_sheets()
 'Simple list of sheets in a workbook
 Dim cRow As Long, csht As Long
 Range("A1").Value = "Sheet names"
 cRow = 2
 For csht = 1 To ActiveWorkbook.Sheets.Count  'worksheet or sheets
     Cells(cRow - 1 + csht, 1) = "'" & Sheets(csht).Name
  Next csht
  '-- make first row bold
  Rows("1:1").FONT.Bold = True
  Columns("A:A").EntireColumn.AutoFit
  '-- sort cells with sheetnames
  Cells.Select
  Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

'Just another example...
Sub MsgBoxAllMySheets()
  Dim sht As Worksheet
  For Each sht In Sheets
    MsgBox sht.name
  Next sht
End Sub

Sample inventory sheet

=SUM('prt001:prtnnn'!B2)       look at 3D in HELP

You have sheet prt001 on left and a dummy sheet prtnnn on the right all sheets physically between (and inclusive) would be in total.&nbs; Does not matter what sheets are named in between.

This would allow you to have the balance in a specified spot Disadvantage is that freeze panes would have to include more than the top most line. Though you would see a balance at all times. (remove line 1 and column F below in actual spreadsheet)

 ABCDEF
1       Formula
2Balance: 805    =E5+SUM(C:C)-SUM(D:D)
3       
4DateDesc Qty InQty OutBalance  
507/31/2001    800 800
608/01/2001  10 810 =OFFSET(E6,-1,0)+C6-D6
708/02/2001   23787 =OFFSET(E7,-1,0)+C7-D7
808/03/2001  44 831 =OFFSET(E8,-1,0)+C8-D8
908/04/2001   62769 =OFFSET(E9,-1,0)+C9-D9
1008/05/2001  223  992 =OFFSET(E10,-1,0)+C10-D10
1108/06/2001   256 736 =OFFSET(E11,-1,0)+C11-D11
1208/07/2001  44  780 =OFFSET(E12,-1,0)+C12-D12
1308/08/2001   175 605 =OFFSET(E13,-1,0)+C13-D13
1408/09/2001  200  805 =OFFSET(E14,-1,0)+C14-D14

Related

This is simply an extension of my Build Table of Contents with this page describing a specific aspect of creating a summary sheet and the macros of interest in maintaining it.  Also see Worksheet VBA Coding

I will have to check out Data, Consolidate and see how that compares to this as I've never looked at it.  Some additional examples of the INDIRECT Worksheet Function (INDIRECT is used in first example here).


You are one of many distinguished visitors who have visited my site here or in a previous location  since this page was created on April 10, 2001.

Visit [my Excel home page]   [Index page]   [Excel Onsite Search]   [top of this page]

Please send your comments concerning this web page to: David McRitchie send email comments


Copyright © 1997 - 2004,  F. David McRitchie,  All Rights Reserved