a list of all formula in activeworkbook

[lior03]

hello
is it possible to get a list of all formula in activeworkbook.namely get excel open a new workbook and list in a single worksheet in one column the sheet name the second column the cell address and the third column the formula itself?
thanks

[rory]

You could try this:
Sub listformulas()
Dim wbk As Workbook, wbkSource As Workbook
Dim wksSummary As Worksheet, wks As Worksheet
Dim lngRow As Long
Dim rngcell As Range, rngFormulas As Range

On Error GoTo err_handle

Set wbkSource = ActiveWorkbook
Set wbk = Workbooks.Add
Set wksSummary = wbk.Sheets(1)
lngRow = 1
For Each wks In wbkSource.Worksheets
With wks
On Error Resume Next
Set rngFormulas = .UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo err_handle
If Not rngFormulas Is Nothing Then
For Each rngcell In rngFormulas
wksSummary.Cells(lngRow, 1).Value = .Name
wksSummary.Cells(lngRow, 2).Value = rngcell.Address
wksSummary.Cells(lngRow, 3).Value = "'" & rngcell.Formula
lngRow = lngRow + 1
If lngRow > 65536 Then
Set wksSummary = wbk.Sheets.Add
lngRow = 1
End If
Next rngcell
Else
Err.Clear
End If
End With
Next wks

leave:
Exit Sub

err_handle:
Resume leave
End Sub

[lior03]

hello
this is what i made of rory's code:

Application.ScreenUpdating = False
Dim wbk As Workbook, wbkSource As Workbook
Dim wksSummary As Worksheet, wks As Worksheet
Dim lngRow As Long
Dim rngcell As Range, rngFormulas As Range
On Error GoTo err_handle
Set wbkSource = ActiveWorkbook
Set wbk = Workbooks.Add(xlWorksheet)
Set wksSummary = wbk.Sheets(1)
wksSummary.name = "formula - " & " " & wbkSource.name
wksSummary.Cells.Font.Bold = True
lngRow = 1
For Each wks In wbkSource.Worksheets
With wks
On Error Resume Next
Set rngFormulas = .UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo err_handle
If Not rngFormulas Is Nothing Then
For Each rngcell In rngFormulas
[A1].resize(, 3).Value = Array("Worsheet", "address", "formula")
wksSummary.Cells(lngRow, 1).Value = .name
wksSummary.Cells(lngRow, 2).Value = rngcell.Address
wksSummary.Cells(lngRow, 3).Value = "'" & rngcell.Formula
lngRow = lngRow + 1
wksSummary.Columns.autofit
If lngRow > 65536 Then
Set wksSummary = wbk.Sheets.Add
lngRow = 1
End If
Next rngcell
Else
err.clear
End If
End With
Next wks
leave:
Exit Sub
err_handle:
Resume leave
Application.ScreenUpdating = True


i noticed that when i open a workbook & enter one formula the reoprt generats two lines- namely two formula each in other sheets of the active wb.why?

[rory]

I can't reproduce that behaviour. If I enter one formula, I get one line output.

[anandbohra]

can we add hyperlink to the address of the cell to navigate better???
if yes pl provide code for that one also

[lior03]

can you provide hyperlink?

[rory]

You could try this - it creates a summary sheet in the activeworkbook with links to the formula cells:
Sub formlist()
Application.ScreenUpdating = False
Dim wbkSource As Workbook
Dim wksSummary As Worksheet, wks As Worksheet
Dim lngRow As Long
Dim rngcell As Range, rngFormulas As Range
On Error GoTo err_handle
Set wbkSource = ActiveWorkbook
Set wksSummary = wbkSource.Sheets.Add(before:=wbkSource.Sheets(1))
wksSummary.Name = "formula - " & " " & wbkSource.Name
wksSummary.Cells.Font.Bold = True
lngRow = 2
wksSummary.[A1].Resize(, 3).Value = Array("Worsheet", "address", "formula")
For Each wks In wbkSource.Worksheets
If Not wks Is wksSummary Then
With wks
On Error Resume Next
Set rngFormulas = .UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo err_handle
If Not rngFormulas Is Nothing Then
For Each rngcell In rngFormulas
With wksSummary
.Cells(lngRow, 1).Value = wks.Name
.Hyperlinks.Add Anchor:=.Cells(lngRow, 2), Address:="", SubAddress:="'" & wks.Name & "'!" & rngcell.Address, TextToDisplay:=rngcell.Address
.Cells(lngRow, 3).Value = "'" & rngcell.Formula
lngRow = lngRow + 1
.Columns.AutoFit
End With
If lngRow > 65536 Then
Set wksSummary = wbk.Sheets.Add
lngRow = 1
End If
Next rngcell
Else
Err.Clear
End If
End With
End If
Next wks
leave:
Exit Sub
err_handle:
Resume leave
Application.ScreenUpdating = True

End Sub

[lior03]

hello rory
your code work fine .the only problem is that not all formula in workbook are listed in the report.another problem - how can a report for formula can specify a blank cell as having a formula?
thanks

[rory]

Can you post a workbook demonstrating the problem?

[CCkfm2000]

Hi Lior03

check out http://j-walk.com/ss/excel/tips/tip37.htm

[lior03]

hello
i want to tell the user a workbook do not contain any formula through a msgbox

Application.ScreenUpdating = False
Dim wbkSource As Workbook
Dim wksSummary As Worksheet, wks As Worksheet
Dim lngRow As Long
Dim rngcell As Range, rngFormulas As Range
On Error GoTo err_handle
Set wbkSource = ActiveWorkbook
With wks
Set rngFormulas = .UsedRange.SpecialCells(xlCellTypeFormulas)
If rngFormulas Is Nothing Then
MsgBox "there are no formula in" & ActiveWorkbook.FullName, vbInformation + vbOKOnly, "formula indicator"
Set wksSummary = wbkSource.Sheets.Add(before:=wbkSource.Sheets(1))
wksSummary.name = "formula - " & " " & wbkSource.name
wksSummary.Cells.Font.Bold = True
lngRow = 2
wksSummary.[A1].resize(, 3).Value = Array("Worsheet", "address", "formula")
For Each wks In wbkSource.Worksheets
If Not wks Is wksSummary Then
On Error Resume Next
On Error GoTo err_handle
If Not rngFormulas Is Nothing Then
For Each rngcell In rngFormulas
With wksSummary
.Cells(lngRow, 1).Value = wks.name
.Hyperlinks.Add Anchor:=.Cells(lngRow, 2), Address:="", SubAddress:="'" & wks.name & "'!" & rngcell.Address, TextToDisplay:=rngcell.Address
.Cells(lngRow, 3).Value = "'" & rngcell.Formula
lngRow = lngRow + 1
.Columns.autofit
End With
lngRow = 1
Next rngcell
Else
err.clear
End If
End If
Next wks
leave:
Exit Sub
err_handle:
Resume leave
Application.ScreenUpdating = True
End If
End With


i tried to fix roryws code.please help
thanks

[lior03]

hello
i am enclosing a workbook containing a sheet with two formulas.i added rory report as well as john walkebbach 's.rory report hase a problem.it duplicate formulas .all formulas appear in sheet 1 why does the report mention sheet 2 and sheet 3.
thanks

[lior03]

here is the file

[lior03]

a winzip version

[rory]

Sorry that was very sloppy of me - you need to add this:
Set rngFormulas = Nothing

before the
Next wks
line, then it should be fine.

[lior03]

thanks rory.that's fine.last question-i used the sigma icon to enter a sum range formula.it did not appear in the report.when i enter the formula manually it appeared.why?
thanks a lot

[rory]

You added a title row and you put it within the loop, so it overwrites the first formula found. Use this version:
Sub listformulasinthisworkbook()
Dim wbk As Workbook, wbkSource As Workbook
Dim wksSummary As Worksheet, wks As Worksheet
Dim lngRow As Long
Dim rngcell As Range, rngFormulas As Range

On Error GoTo err_handle
Application.ScreenUpdating = False
Set wbkSource = ActiveWorkbook
Set wbk = Workbooks.Add(xlWorksheet)
Set wksSummary = wbk.Sheets(1)
wksSummary.Name = "formula - " & " " & wbkSource.Name
wksSummary.Cells.Font.Bold = True
lngRow = 2
[A1].Resize(, 4).Value = Array("Worsheet", "address", "formula", "value")
For Each wks In wbkSource.Worksheets
With wks
On Error Resume Next
Set rngFormulas = .UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo err_handle
If Not rngFormulas Is Nothing Then
For Each rngcell In rngFormulas
wksSummary.Cells(lngRow, 1).Value = .Name
wksSummary.Cells(lngRow, 2).Value = rngcell.Address
wksSummary.Cells(lngRow, 3).Value = "'" & rngcell.Formula
wksSummary.Cells(lngRow, 4).Value = "'" & rngcell.Value
lngRow = lngRow + 1
wksSummary.Columns.AutoFit
If lngRow > 65536 Then
Set wksSummary = wbk.Sheets.Add
lngRow = 1
End If
Next rngcell
Else
Err.Clear
End If
End With
Set rngFormulas = Nothing
Next wks
leave:
Exit Sub
err_handle:
Resume leave
Application.ScreenUpdating = True
End Sub

[lior03]

hello
this is the most recent version i use.i may bbe wrong but this cod do not work on all workbook . why?

Sub listformulasinthisworkbook()
Dim wbk As Workbook, wbkSource As Workbook
Dim wksSummary As Worksheet, wks As Worksheet
Dim lngRow As Long
Dim rngcell As Range, rngFormulas As Range
On Error GoTo err_handle
Application.ScreenUpdating = False
Set wbkSource = ActiveWorkbook
Set wbk = Workbooks.Add(xlWorksheet)
Set wksSummary = wbk.Sheets(1)
wksSummary.name = "formula - " & " " & wbkSource.name
wksSummary.Cells.Font.Bold = True
lngRow = 2
[A1].Resize(, 5).Value = Array("Worsheet", "address", "formula", "value", "number")
For Each wks In wbkSource.Worksheets
With wks
On Error Resume Next
Set rngFormulas = .UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo err_handle
If Not rngFormulas Is Nothing Then
For Each rngcell In rngFormulas
wksSummary.Cells(lngRow, 1).Value = .name
wksSummary.Cells(lngRow, 2).Value = rngcell.Address
wksSummary.Cells(lngRow, 3).Value = "'" & rngcell.Formula
wksSummary.Cells(lngRow, 4).Value = "'" & rngcell.Value
wksSummary.Cells(lngRow, 5).FormulaR1C1 = "=rows(R1C:R[-1]C)"
lngRow = lngRow + 1
wksSummary.Columns.autofit
If lngRow > 65536 Then
Set wksSummary = wbk.Sheets.Add
lngRow = 1
End If
Next rngcell
Else
err.clear
End If
End With
Set rngFormulas = Nothing
selection.CurrentRegion.Select
selection.FormatConditions.Delete
selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$A2<>$A1"
With selection.FormatConditions(1).borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With selection.FormatConditions(1).borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With selection.FormatConditions(1).borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With selection.FormatConditions(1).borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Next wks
leave:
Exit Sub
err_handle:
Resume leave
Application.ScreenUpdating = True
End Sub


thanks

[lior03]

hello
this is another version, i found in j-walk.com.i adjusted to my needs.
how can i prevent the macro from generating a formula sheet for a sheet without formulas?.i just want to notify the user a certain sheet has no formulas and go on to check the next sheet?

Sub ListFormulasineveryactivesheet()
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim ws As Worksheet
Dim Row As Integer
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
Set FormulaCells = ws.Range("A1").SpecialCells(xlFormulas, 23)
If FormulaCells Is Nothing Then
MsgBox "No Formulas cells in :" & ws.name, vbInformation, "a message"
End If
Application.ScreenUpdating = False
Set FormulaSheet = Workbooks.Add(xlWorksheet)
FormulaSheet.name = "Formulas in " & ActiveWorkbook.name
With FormulaSheet
[A1].Resize(, 5).Value = Array("address", "formula", "value", "name", "#")
Range("A1:E1").Font.Bold = True
End With
Row = 2
For Each Cell In FormulaCells
With FormulaSheet
Cells(Row, 1) = Cell.Address _
(RowAbsolute:=False, ColumnAbsolute:=False)
Cells(Row, 2) = " " & Cell.Formula
Cells(Row, 3) = Cell.Value
Cells(Row, 4) = ws.name
Cells(Row, 5) = "=rows(R1C:R[-1]C)"
Row = Row + 1
End With
Set FormulaCells = Nothing
Next Cell
FormulaSheet.Columns("A:D").autofit
Application.StatusBar = False
Next
End Sub

[Bob Phillips]

Option Explicit

Sub ListFormulasineveryactivesheet()
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim ws As Worksheet
Dim Row As Integer
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
Set FormulaCells = ws.Range("A1").SpecialCells(xlFormulas, 23)
If FormulaCells Is Nothing Then
MsgBox "No Formulas cells in :" & ws.Name, vbInformation, "a message"
Else
Application.ScreenUpdating = False
Set FormulaSheet = Workbooks.Add(xlWorksheet)
FormulaSheet.Name = "Formulas in " & ActiveWorkbook.Name
With FormulaSheet
[A1].Resize(, 5).Value = Array("address", "formula", "value", "name", "#")
Range("A1:E1").Font.Bold = True
End With
Row = 2
For Each Cell In FormulaCells
With FormulaSheet
Cells(Row, 1) = Cell.Address _
(RowAbsolute:=False, ColumnAbsolute:=False)
Cells(Row, 2) = " " & Cell.Formula
Cells(Row, 3) = Cell.Value
Cells(Row, 4) = ws.Name
Cells(Row, 5) = "=rows(R1C:R[-1]C)"
Row = Row + 1
End With
Set FormulaCells = Nothing
Next Cell
FormulaSheet.Columns("A:D").AutoFit
Application.StatusBar = False
End If
Next
End Sub

[lior03]

hello
this is my latest version.how can i make sure excel will dill with only visible formula cells.

Sub ListFormulasineveryactivesheet()
Dim FormulaCells As Range, cell As Range
Dim FormulaSheet As Worksheet
Dim ws As Worksheet
Dim Row As Integer
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
Set FormulaCells = ws.Range("A1").SpecialCells(xlFormulas, 23)
If FormulaCells Is Nothing Then
MsgBox "No Formulas cells in :" & ws.name, vbInformation, "a message"
Else
Application.ScreenUpdating = False
Set FormulaSheet = Workbooks.Add(xlWorksheet)
FormulaSheet.name = "Formulas in " & ws.name
With FormulaSheet
[A1].Resize(, 5).Value = Array("address", "formula", "value", "name", "#")
Range("A1:E1").Font.Bold = True
End With
Row = 2
For Each cell In FormulaCells
With FormulaSheet
Cells(Row, 1) = cell.Address _
(RowAbsolute:=False, ColumnAbsolute:=False)
Cells(Row, 2) = " " & cell.Formula
Cells(Row, 3) = Format(cell.Value, "#,##0.00")
Cells(Row, 4) = ws.name
Cells(Row, 5) = "=rows(R1C:R[-1]C)"
Row = Row + 1
End With
Set FormulaCells = Nothing
Next cell
FormulaSheet.Columns("A:E").autofit
FormulaSheet.name = "Formulas in " & ws.name
End If
End If
Next
End Sub

thanks