Create Index Sheet

kevint504 · Mar 8, 2006

I often find myself wanting to create an index sheet at the front of a workbook so I can notate what all the other sheets are for. I'd like to write a macro that will create the sheet and then list the names of all the other sheets, but I just don't know how. I've got as far as creating the index sheet and putting a title in cell A2:

Code:

Sheets.Add
    ActiveSheet.Name = "Index"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Index"

So now I need some kind of For Next loop to list the titles of the other sheets.

A related (but perhaps not really excel) question - is there a way of creating an index sheet of all the workbooks in a particular folder? (Other than typing them by hand)
I'm running xl2000 and windows2000

many thanks for any help,

Kev

Norie · Mar 8, 2006

Kev

For the first question.

Code:

Dim wsIndex As Worksheet
Dim ws As Worksheet
Dim I As Long

Set wsIndex = Worksheets.Add
wsIndex.Name = "Index"
wsIndex.Range("A2")="Index
I = 3
For Each ws In Worksheets
     If ws.Name<>wsIndex.Name Then
        wsIndex.Range("A"&I) = ws.Name
        I=I+1
     End If
Next ws

For the second I suggest you search the board for list files/workbooks.

Barry Katcher · Mar 8, 2006

ASAP Utilities has a really nifty Index Sheet function, with masses of options. Free download at:
http://www.asap-utilities.com/

kevint504 · Mar 8, 2006

Thanks Norie, that helps me an enormous amount.
And ta to Barry for the link - looks good.

Brian at ML · Jul 18, 2006

Sub GetSheets()
Dim q As Integer
Dim NumSheets As Integer

NumSheets = Sheets.Count
For q = 1 To NumSheets
Cells(q, 1) = Sheets(q).Name
Next q
End Sub

It overwrites column a, so you might want to run it on a blank sheet

Smitty · Jul 18, 2006

Check out Firefytr's code that create's a Table of Contents with hyperlinkls to each sheet:

Option Explicit

Sub CreateTOC()
 ' Code by Zack Baresse
 If ActiveWorkbook Is Nothing Then
 MsgBox "You must have a workbook open first!", vbInformation, "No Open Book"
 Exit Sub
 End If

 With Application
 .ScreenUpdating = False
 .DisplayAlerts = False

 Dim ws As Worksheet, _
 ct As Chart, _
 shtName As String, _
 nrow As Long, _
 tmpCount As Long, _
 i As Long, _
 numCharts As Long

 nrow = 3
 i = 1
 numCharts = ActiveWorkbook.Charts.Count

 On Error GoTo hasSheet
 Sheets("TOC").Activate
 If MsgBox("You already have a Table of Contents page. Would you like to overwrite it?", _
 vbYesNo + vbQuestion, "Replace TOC page?") = vbYes Then GoTo createNew
 Exit Sub

hasSheet:
 Sheets.Add Before:=Sheets(1)
 GoTo hasNew

createNew:
 Sheets("TOC").Delete
 GoTo hasSheet

hasNew:
 tmpCount = ActiveWorkbook.Charts.Count
 If tmpCount > 0 Then tmpCount = 1
 ActiveSheet.Name = "TOC"

 With Sheets("TOC")
 .Cells.Interior.ColorIndex = 4
 With .Range("B2")
 .Value = "Table of Contents"
 .Font.Bold = True
 .Font.Name = "Tahoma"
 .Font.Size = "24"
 End With
 End With

 For Each ws In ActiveWorkbook.Worksheets
 nrow = nrow + 1
 With ws
 shtName = ws.Name
 With Sheets("TOC")
 .Range("B" & nrow).Value = nrow - 3
 .Range("C" & nrow).Hyperlinks.Add _
 Anchor:=Sheets("TOC").Range("C" & nrow), Address:="#'" & _
 shtName & "'!A1", TextToDisplay:=shtName
 .Range("C" & nrow).HorizontalAlignment = xlLeft
 End With
 End With
 Next ws

 If numCharts <> 0 Then
 For Each ct In ActiveWorkbook.Charts
 nrow = nrow + 1
 shtName = ct.Name
 With Sheets("TOC")
 .Range("B" & nrow).Value = nrow - 3
 .Range("C" & nrow).Value = shtName
 .Range("C" & nrow).HorizontalAlignment = xlLeft
 End With
 Next ct
 End If

 With Sheets("TOC")
 With .Range("B2:G2")
 .MergeCells = True
 .HorizontalAlignment = xlLeft
 End With

 With .Range("C:C")
 .EntireColumn.AutoFit
 .Activate
 End With
 .Range("B4").Select
 End With

 .DisplayAlerts = True
 .ScreenUpdating = True
 End With

 MsgBox "Done!" & vbNewLine & vbNewLine & "Please note: " & _
 "Charts are listed after regular " & vbCrLf & _
 "worksheets and will not have hyperlinks.", vbInformation, "Complete!"

End Sub


HTH,

Smitty

Airfix9 · Oct 26, 2006

Can I just say that that is EXCELLENT code.

I have added one teensy change to it under "hasnew:"

When constructing the TOC, my addition only looks for VISIBLE sheets:

Code:

        For Each ws In ActiveWorkbook.Worksheets
        
        If ws.Visible = xlSheetVisible Then
        
            nrow = nrow + 1
            With ws
                shtName = ws.Name
                With Sheets("TOC")
                    .Range("B" & nrow).Value = nrow - 3
                    .Range("C" & nrow).Hyperlinks.Add _
                        Anchor:=Sheets("TOC").Range("C" & nrow), Address:="#'" & _
                        shtName & "'!A1", TextToDisplay:=shtName
                    .Range("C" & nrow).HorizontalAlignment = xlLeft
                End With
            End With
            
        End If
        
        Next ws

My team now all love me for finding this... thanks pennysaver and (most of all) Firefytr!

Create Index Sheet

kevint504

New Member

Excel Facts

Norie

Well-known Member

Barry Katcher

Well-known Member

kevint504

New Member

Brian at ML

Board Regular

Smitty

Legend

Airfix9

Well-known Member

Similar threads

Forum statistics

Share this page

Create Index Sheet

kevint504

New Member

Excel Facts

Norie

Well-known Member

Barry Katcher

Well-known Member

kevint504

New Member

Brian at ML

Board Regular

Smitty

Legend

Airfix9

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock