Creating a Workbook Index using a macro

[Denise]

I've been trying to make complicated analyses more transparent and accessible to new users.

Yesterday someone helped me create a macro that generates a list of each of the worksheets in a workbook.

It works great, but after applying it to a few workbooks I think the process would be substantially improved if I could add the following:

1) if every worksheet had a named cell that contained a brief description of the source and use of data on the worksheet, then when the index listed the worksheet name in column A, the description could be listed in column B.

2) if possible, column C could list all worksheets/workbooks that use the listed worksheet as a source of data; and column D could list every worksheet/workbook that the listed sheet used as a source of data.

I've included the first part of the code below. Thanks to anyone who can help.

Denise

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer
Worksheets("Index").Range("A:A").ClearContents
For Each ws In ThisWorkbook.Worksheets
i = i + 1
Worksheets("Index").Range("A" & i) = ws.Name
Next ws

End Sub

 

[rikrak]

Hi Denise,

Descriptions of sheets in A1.

This code creates:
column A=sheet names
column B=sheet descriptions (from A1)
column C=unable to fill
column D=list of sheets used as datasource
<pre>
Sub createindex()
Dim ws As Worksheet
Dim i As Integer

' clear previous index
Worksheets("Index").Range("A:D").ClearContents

For Each ws In ThisWorkbook.Worksheets
' skip Index sheet
If ws.Name <> "Index" Then
i = i + 1
' store worksheet name in colum A
Worksheets("Index").Range("A" & i) = ws.Name
' store description in column B
Worksheets("Index").Range("B" & i) = ws.Range("A1")
' store links in column C
Worksheets("Index").Range("D" & i) = linkInfo(ws.UsedRange)
End If
Next ws

End Sub

Function linkInfo(rng As Range) As String
Dim r As Range
Dim shname As String

' check all cells
For Each r In rng
If r.HasFormula Then
If InStr(r.Formula, "!") Then
' extract sheet name
shname = Left(r.Formula, InStr(r.Formula, "!") - 1)
shname = Replace(shname, "=", "")

' create list (prevent duplicates)
If InStr(linkInfo, shname) = 0 Then
linkInfo = linkInfo & shname & " "
End If
End If
End If
Next r
End Function
</pre>

 

[Denise]

One question before I give it a try - Do I leave the previous code above what you've sent me? Or do I overwrite?

Thanks a lot for your help!

Denise

 

[rikrak]

On 2002-10-19 14:37, Denise wrote:
One question before I give it a try - Do I leave the previous code above what you've sent me? Or do I overwrite?

Thanks a lot for your help!

Denise

The old code runs as the workbook opens. The code i posted can be placed in a new module and can be started as any other macro.

 

[rikrak]

Denise, me again.

Replace the old code with this:
<pre>
Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer

' clear previous index
Worksheets("Index").Range("A:D").ClearContents

For Each ws In ThisWorkbook.Worksheets
' skip Index sheet
If ws.Name <> "Index" Then
i = i + 1
' store worksheet name in colum A
Worksheets("Index").Range("A" & i) = ws.Name
' store description in column B
Worksheets("Index").Range("B" & i) = ws.Range("A1")
' store links in column C
Worksheets("Index").Range("D" & i) = linksInfo(ws.UsedRange)
End If
Next ws
End Sub
Function linksInfo(rng As Range) As String
Dim r As Range
Dim shname As String

' check all cells
For Each r In rng
If r.HasFormula Then
If InStr(r.Formula, "!") Then
' extract sheet name
shname = Left(r.Formula, InStr(r.Formula, "!") - 1)
shname = Replace(shname, "=", "")

' create list and prevent duplicates
If InStr(linksInfo, shname) = 0 Then
linksInfo = linksInfo & shname & " / "
End If
End If
End If
Next r
End Function
</pre>