Formula audit is useful with its arrows. I'm looking for a way to build out
(to print) a tree of all dependent formulae, starting from a set of known
independent input cells. Any ideas how to proceed ?

(application - to extract the constituent rules / equations and variables
from a spreadsheet )

BR
--
-----

I see three other posts from you over the last two days.
You did not respond to any of the answers provided.
Maybe it is time to read this post from Microsoft...
http://support.microsoft.com/KB/555375
"How to ask a question"
--
Jim Cone
Portland, Oregon USA



"BR"

wrote in message
Formula audit is useful with its arrows. I'm looking for a way to build out
(to print) a tree of all dependent formulae, starting from a set of known
independent input cells. Any ideas how to proceed ?

(application - to extract the constituent rules / equations and variables
from a spreadsheet )

BR
--
-----

Apologies, please ignore this question should you find it poorly phrased. I
diligently thank people who help me & click the Yes option as well, when
comments are helpful

I don't work in a company that has a dedicated IT desk. This is my only
resort for help on MS Excel. Due to the nature of work, I am confronted with
spreadsheets that have several formulae but little documentation several
times. It takes great effort to audit / demystify.

Best,
BR


--
-----


"Jim Cone" wrote:

I see three other posts from you over the last two days.
You did not respond to any of the answers provided.
Maybe it is time to read this post from Microsoft...
http://support.microsoft.com/KB/555375
"How to ask a question"
--
Jim Cone
Portland, Oregon USA



"BR"

wrote in message
Formula audit is useful with its arrows. I'm looking for a way to build out
(to print) a tree of all dependent formulae, starting from a set of known
independent input cells. Any ideas how to proceed ?

(application - to extract the constituent rules / equations and variables
from a spreadsheet )

BR
--
-----

You can try running my Formula MapIV code shown below
(watch for and correct any word wrap created by the email)

-or-

try the demo version of Jan Karel Pieterse's RefTree program...
http://www.jkp-ads.com/RefTreeAnalyser.asp

'--
Sub FindFormulaMapIV()
' Finds worksheet formulas on each sheet in workbook.
' Adds a new worksheet and lists all formulas found and their _
' cell addresses, values and precedents.
' Formulas that have error values in the formula will also appear on the list.
' Formulas that contain references to other sheets are _
' marked with a "!" in column A.
' Calls MaxShtNum function.
' Aug 29, 2004 - Created by James Cone - Portland, Oregon USA
' Sep 06, 2004 - Added dependents.
' Oct 08, 2004 - Added blnFound variable and MsgBox.
' Dec 09, 2004 - Added check for merged cells.
' Jan 16, 2009 - Minor clean up.
On Error GoTo ErrFindingFormulas
Dim objNewSht As Excel.Worksheet
Dim objAllShts As Excel.Sheets
Dim FormulaRange As Excel.Range
Dim FormulaCell As Excel.Range
Dim objGeneric As Excel.Range
Dim objCell As Excel.Range
Dim objSht As Object
Dim lngD As Long
Dim lngP As Long
Dim lngR As Long
Dim lngC As Long
Dim blnFound As Boolean
Const strMark As String = "!"

Application.ScreenUpdating = False
' Sheet selection is an event so...
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
lngC = MaxShtNum
Set objAllShts = ActiveWindow.SelectedSheets
Set objNewSht = Worksheets.Add(Befo=Sheets(1), Count:=1)
On Error Resume Next
objNewSht.Name = "Formula List " & lngC
On Error GoTo ErrFindingFormulas
lngR = 4

' Find all formulas on each worksheet.
For Each objSht In objAllShts
If objSht.ProtectContents Then
Application.DisplayAlerts = False
objNewSht.Delete
Application.ScreenUpdating = True
Application.Cursor = xlDefault
MsgBox objSht.Name & " sheet is protected. " & vbCr & _
"Unprotect the sheet and try again. ", vbExclamation, "Formula Map"
GoTo Exit_FindFormulas
End If

Application.StatusBar = "MAPPING SHEET " & objSht.Name
If TypeName(objSht) = "Worksheet" Then
objSht.Select 'Required
On Error Resume Next
Set FormulaRange = objSht.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo ErrFindingFormulas
If Not FormulaRange Is Nothing Then
blnFound = True
objNewSht.Cells(lngR, 2).Value = objSht.Name
' Add cell address, cell formula and formula value to new sheet.
For Each FormulaCell In FormulaRange
' All but one of a merged group of cells are empty.
' If cell error, Value returns an error, Formula does not.
If Len(FormulaCell.Formula) Then
With objNewSht.Cells(lngR, 3)
.Value = FormulaCell.Address(False, False)
.Offset(0, 1).Value = "'" & FormulaCell.Formula
.Offset(0, 2).Value = FormulaCell.Value
If InStr(1, FormulaCell.Formula, strMark, vbTextCompare) 0 Then
.Offset(0, -2).Interior.ColorIndex = 40
.Offset(0, -2).Value = strMark
End If
End With

On Error Resume Next
Set objGeneric = FormulaCell.Precedents
On Error GoTo ErrFindingFormulas
If Not objGeneric Is Nothing Then
If IsNull(objGeneric.MergeCells) Or objGeneric.MergeCells Then
lngP = 1
objNewSht.Cells(lngR, 6).Value = "Merged"
Else
lngP = objGeneric.Count
lngC = 0
' Add precedents to new sheet.
For Each objCell In objGeneric
With objNewSht.Cells(lngR + lngC, 6)
.Value = objCell.Address(False, False)
.Offset(0, 1).Value = objCell.Value
End With
lngC = lngC + 1
Next 'objCell
End If
Set objGeneric = Nothing
End If

On Error Resume Next
Set objGeneric = FormulaCell.Dependents
On Error GoTo ErrFindingFormulas
If Not objGeneric Is Nothing Then
If IsNull(objGeneric.MergeCells) Or objGeneric.MergeCells Then
lngD = 1
objNewSht.Cells(lngR, 6).Value = "Merged"
Else
lngD = objGeneric.Count
lngC = 0
' Add dependents to new sheet.
For Each objCell In objGeneric
With objNewSht.Cells(lngR + lngC, 8)
.Value = objCell.Address(False, False)
.Offset(0, 1).Value = objCell.Value
End With
lngC = lngC + 1
Next 'objCell
End If
Set objGeneric = Nothing
End If

' Make sure next row starts after last precedent/dependent.
lngR = lngR + WorksheetFunction.Max(lngP, lngD, 1)
lngP = 0
lngD = 0
End If 'Len(FormulaCell)
Next 'FormulaCell

objNewSht.Cells(lngR - 1, 2).Value = objSht.Name
Set FormulaRange = Nothing
End If 'Not FormulaRange is Nothing
End If 'TypeName Worksheet
Next 'objSht

If blnFound = False Then
Application.DisplayAlerts = False
objNewSht.Delete
Application.ScreenUpdating = True
Application.Cursor = xlDefault
MsgBox "No formulas were found. ", vbInformation, "Formula Map"
GoTo Exit_FindFormulas
End If

objNewSht.Activate
' Determine number of formulas found.
lngC = WorksheetFunction.CountA(objNewSht.Range(Cells(4, 3), _
Cells(lngR - 1, 3)))
' Make it look good.
With objNewSht.Range("B3:I3")
.Value = Array("Sheet Name", "Cell", "Formula ", "Value", _
"Precedents ", "Value", "Dependents ", "Value")
.Font.Bold = True
.Interior.ColorIndex = 40
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
End With
With objNewSht.Range("F3:I3")
.Interior.ColorIndex = 15
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
End With
objNewSht.Range("F3:G3").BorderAround _
LineStyle:=xlContinuous, Weight:=xlThin
With objNewSht.Range(objNewSht.Cells(4, 1), objNewSht.Cells(lngR, 1))
.HorizontalAlignment = xlHAlignCenter
With .Item(.Rows.Count + 2)
.Value = " Formula MapIV - " & Format$(Date, "mm/dd/yy")
.Font.Size = 8
End With
End With
objNewSht.Range("E:E, G:G, I:I").HorizontalAlignment = xlLeft
objNewSht.Columns("A").ColumnWidth = 3
objNewSht.Columns("B:I").AutoFit
' After AutoFit
objNewSht.Range("B1").Value = lngC & " Formulas Found"
For lngC = 2 To 9
With objNewSht.Columns(lngC)
If .ColumnWidth 30 Then .ColumnWidth = 30
End With
Next 'lngC
objNewSht.Range("A4").Select
ActiveWindow.FreezePanes = True

Exit_FindFormulas:
On Error Resume Next
Set objSht = Nothing
Set objCell = Nothing
Set objNewSht = Nothing
Set objAllShts = Nothing
Set objGeneric = Nothing
Set FormulaCell = Nothing
Set FormulaRange = Nothing
Application.StatusBar = False
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

ErrFindingFormulas:
Beep
Application.ScreenUpdating = True
MsgBox "Error " & Err.Number & " - " _
& Err.Description, vbCritical, "Formula Map"
Resume Exit_FindFormulas
End Sub

'-----------------------------------
' MaxShtNum() Function
' May 05, 2001 - created by Jim Cone
' Returns a number between 0 and 100.
' Jan 16, 2009 - updated.
'-----------------------------------
Function MaxShtNum() As Long
On Error GoTo BadSheet
Dim Sht As Object
Dim M As Long
Dim N As Long

For Each Sht In ActiveWorkbook.Sheets
M = Val(Right$(Sht.Name, 2))
If M N Then N = M
Next 'Sht
MaxShtNum = N + 1

Set Sht = Nothing
Exit Function
BadSheet:
MaxShtNum = 0
Set Sht = Nothing
End Function
--
Jim Cone
Portland, Oregon USA

Useful. Many thanks!

--
-----


"Jim Cone" wrote:


You can try running my Formula MapIV code shown below
(watch for and correct any word wrap created by the email)

-or-

try the demo version of Jan Karel Pieterse's RefTree program...
http://www.jkp-ads.com/RefTreeAnalyser.asp

'--
Sub FindFormulaMapIV()
' Finds worksheet formulas on each sheet in workbook.
' Adds a new worksheet and lists all formulas found and their _
' cell addresses, values and precedents.
' Formulas that have error values in the formula will also appear on the list.
' Formulas that contain references to other sheets are _
' marked with a "!" in column A.
' Calls MaxShtNum function.
' Aug 29, 2004 - Created by James Cone - Portland, Oregon USA
' Sep 06, 2004 - Added dependents.
' Oct 08, 2004 - Added blnFound variable and MsgBox.
' Dec 09, 2004 - Added check for merged cells.
' Jan 16, 2009 - Minor clean up.
On Error GoTo ErrFindingFormulas
Dim objNewSht As Excel.Worksheet
Dim objAllShts As Excel.Sheets
Dim FormulaRange As Excel.Range
Dim FormulaCell As Excel.Range
Dim objGeneric As Excel.Range
Dim objCell As Excel.Range
Dim objSht As Object
Dim lngD As Long
Dim lngP As Long
Dim lngR As Long
Dim lngC As Long
Dim blnFound As Boolean
Const strMark As String = "!"

Application.ScreenUpdating = False
' Sheet selection is an event so...
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
lngC = MaxShtNum
Set objAllShts = ActiveWindow.SelectedSheets
Set objNewSht = Worksheets.Add(Befo=Sheets(1), Count:=1)
On Error Resume Next
objNewSht.Name = "Formula List " & lngC
On Error GoTo ErrFindingFormulas
lngR = 4

' Find all formulas on each worksheet.
For Each objSht In objAllShts
If objSht.ProtectContents Then
Application.DisplayAlerts = False
objNewSht.Delete
Application.ScreenUpdating = True
Application.Cursor = xlDefault
MsgBox objSht.Name & " sheet is protected. " & vbCr & _
"Unprotect the sheet and try again. ", vbExclamation, "Formula Map"
GoTo Exit_FindFormulas
End If

Application.StatusBar = "MAPPING SHEET " & objSht.Name
If TypeName(objSht) = "Worksheet" Then
objSht.Select 'Required
On Error Resume Next
Set FormulaRange = objSht.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo ErrFindingFormulas
If Not FormulaRange Is Nothing Then
blnFound = True
objNewSht.Cells(lngR, 2).Value = objSht.Name
' Add cell address, cell formula and formula value to new sheet.
For Each FormulaCell In FormulaRange
' All but one of a merged group of cells are empty.
' If cell error, Value returns an error, Formula does not.
If Len(FormulaCell.Formula) Then
With objNewSht.Cells(lngR, 3)
.Value = FormulaCell.Address(False, False)
.Offset(0, 1).Value = "'" & FormulaCell.Formula
.Offset(0, 2).Value = FormulaCell.Value
If InStr(1, FormulaCell.Formula, strMark, vbTextCompare) 0 Then
.Offset(0, -2).Interior.ColorIndex = 40
.Offset(0, -2).Value = strMark
End If
End With

On Error Resume Next
Set objGeneric = FormulaCell.Precedents
On Error GoTo ErrFindingFormulas
If Not objGeneric Is Nothing Then
If IsNull(objGeneric.MergeCells) Or objGeneric.MergeCells Then
lngP = 1
objNewSht.Cells(lngR, 6).Value = "Merged"
Else
lngP = objGeneric.Count
lngC = 0
' Add precedents to new sheet.
For Each objCell In objGeneric
With objNewSht.Cells(lngR + lngC, 6)
.Value = objCell.Address(False, False)
.Offset(0, 1).Value = objCell.Value
End With
lngC = lngC + 1
Next 'objCell
End If
Set objGeneric = Nothing
End If

On Error Resume Next
Set objGeneric = FormulaCell.Dependents
On Error GoTo ErrFindingFormulas
If Not objGeneric Is Nothing Then
If IsNull(objGeneric.MergeCells) Or objGeneric.MergeCells Then
lngD = 1
objNewSht.Cells(lngR, 6).Value = "Merged"
Else
lngD = objGeneric.Count
lngC = 0
' Add dependents to new sheet.
For Each objCell In objGeneric
With objNewSht.Cells(lngR + lngC, 8)
.Value = objCell.Address(False, False)
.Offset(0, 1).Value = objCell.Value
End With
lngC = lngC + 1
Next 'objCell
End If
Set objGeneric = Nothing
End If

' Make sure next row starts after last precedent/dependent.
lngR = lngR + WorksheetFunction.Max(lngP, lngD, 1)
lngP = 0
lngD = 0
End If 'Len(FormulaCell)
Next 'FormulaCell

objNewSht.Cells(lngR - 1, 2).Value = objSht.Name
Set FormulaRange = Nothing
End If 'Not FormulaRange is Nothing
End If 'TypeName Worksheet
Next 'objSht

If blnFound = False Then
Application.DisplayAlerts = False
objNewSht.Delete
Application.ScreenUpdating = True
Application.Cursor = xlDefault
MsgBox "No formulas were found. ", vbInformation, "Formula Map"
GoTo Exit_FindFormulas
End If

objNewSht.Activate
' Determine number of formulas found.
lngC = WorksheetFunction.CountA(objNewSht.Range(Cells(4, 3), _
Cells(lngR - 1, 3)))
' Make it look good.
With objNewSht.Range("B3:I3")
.Value = Array("Sheet Name", "Cell", "Formula ", "Value", _
"Precedents ", "Value", "Dependents ", "Value")
.Font.Bold = True
.Interior.ColorIndex = 40
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
End With
With objNewSht.Range("F3:I3")
.Interior.ColorIndex = 15
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
End With
objNewSht.Range("F3:G3").BorderAround _
LineStyle:=xlContinuous, Weight:=xlThin
With objNewSht.Range(objNewSht.Cells(4, 1), objNewSht.Cells(lngR, 1))
.HorizontalAlignment = xlHAlignCenter
With .Item(.Rows.Count + 2)
.Value = " Formula MapIV - " & Format$(Date, "mm/dd/yy")
.Font.Size = 8
End With
End With
objNewSht.Range("E:E, G:G, I:I").HorizontalAlignment = xlLeft
objNewSht.Columns("A").ColumnWidth = 3
objNewSht.Columns("B:I").AutoFit
' After AutoFit
objNewSht.Range("B1").Value = lngC & " Formulas Found"
For lngC = 2 To 9
With objNewSht.Columns(lngC)
If .ColumnWidth 30 Then .ColumnWidth = 30
End With
Next 'lngC
objNewSht.Range("A4").Select
ActiveWindow.FreezePanes = True

Exit_FindFormulas:
On Error Resume Next
Set objSht = Nothing
Set objCell = Nothing
Set objNewSht = Nothing
Set objAllShts = Nothing
Set objGeneric = Nothing
Set FormulaCell = Nothing
Set FormulaRange = Nothing
Application.StatusBar = False
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

ErrFindingFormulas:
Beep
Application.ScreenUpdating = True
MsgBox "Error " & Err.Number & " - " _
& Err.Description, vbCritical, "Formula Map"
Resume Exit_FindFormulas
End Sub

'-----------------------------------
' MaxShtNum() Function
' May 05, 2001 - created by Jim Cone
' Returns a number between 0 and 100.
' Jan 16, 2009 - updated.
'-----------------------------------
Function MaxShtNum() As Long
On Error GoTo BadSheet
Dim Sht As Object
Dim M As Long
Dim N As Long

For Each Sht In ActiveWorkbook.Sheets
M = Val(Right$(Sht.Name, 2))
If M N Then N = M
Next 'Sht
MaxShtNum = N + 1

Set Sht = Nothing
Exit Function
BadSheet:
MaxShtNum = 0
Set Sht = Nothing
End Function
--
Jim Cone
Portland, Oregon USA