List Formula Macro Needs Enhancement

G

Guest

The below macro creates a worksheet and lists all formulas contained in the
target worksheet; however, it needs a tweak. Some worksheet formulas are
contained in a merged cell range and the output lists all the blank cells of
the range, as well as the one cell holding the formula. Is there a way to
modify the code to not list the blank cells of the range?


Sub ListFormulas()
'This code creates a new worksheet, lists cell addresses (column A),
'formulas (column B), and formula return values (column C).
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer

'Create a range object for all formula cells
On Error Resume Next
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)

'Exit if no formulas found
If FormulaCells Is Nothing Then
MsgBox "No Formulas, or, the worksheet is protected."
Exit Sub
End If

'Add a new worksheet
Application.ScreenUpdating = False
Set FormulaSheet = ActiveWorkbook.Worksheets.Add
FormulaSheet.Name = "Formulas in " & FormulaCells.Parent.Name

'Set up the column headings
With FormulaSheet
Range("A1") = "ADDRESS"
Range("B1") = "FORMULA"
Range("C1") = "VALUE"
Range("A1:C1").Font.Bold = True
Range("A1:C1").Font.ColorIndex = 5
Range("A1:C1").HorizontalAlignment = xlCenter
Range("A1:C1").Interior.ColorIndex = 19
End With
Range("A2").Select
ActiveWindow.FreezePanes = True

'Process each formula
Row = 2
For Each Cell In FormulaCells
Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
With FormulaSheet
Cells(Row, 1) = Cell.Address(RowAbsolute:=False,
ColumnAbsolute:=False)
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 1).Font.ColorIndex = 3
Cells(Row, 1).Font.FontStyle = "Bold"
Cells(Row, 1).VerticalAlignment = xlCenter
Cells(Row, 1).HorizontalAlignment = xlCenter
End If
Cells(Row, 2) = " " & Cell.Formula
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 2).Font.ColorIndex = 3
Cells(Row, 2).Font.FontStyle = "Bold"
Cells(Row, 2).VerticalAlignment = xlCenter
Cells(Row, 2).HorizontalAlignment = xlLeft
End If
Cells(Row, 3) = Cell.Value
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 3).Font.ColorIndex = 3
Cells(Row, 3).Font.FontStyle = "Bold"
Cells(Row, 3).VerticalAlignment = xlCenter
Cells(Row, 3).HorizontalAlignment = xlCenter
End If
Row = Row + 1
End With
Next Cell

'Adjust column widths
With FormulaSheet
.Columns("A:A").AutoFit
With .Columns("B:C")
.ColumnWidth = 45
.WrapText = True
End With
..Rows("1:1000").AutoFit
End With
FormulaSheet.Columns("A:C").AutoFit
Application.StatusBar = False

End Sub
 
T

Tom Ogilvy

For Each Cell In FormulaCells
Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
If Left(cell(1).Formula,1) = "=" then
With FormulaSheet
Cells(Row, 1) = Cell.Address(RowAbsolute:=False,
ColumnAbsolute:=False)
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 1).Font.ColorIndex = 3
Cells(Row, 1).Font.FontStyle = "Bold"
Cells(Row, 1).VerticalAlignment = xlCenter
Cells(Row, 1).HorizontalAlignment = xlCenter
End If
Cells(Row, 2) = " " & Cell.Formula
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 2).Font.ColorIndex = 3
Cells(Row, 2).Font.FontStyle = "Bold"
Cells(Row, 2).VerticalAlignment = xlCenter
Cells(Row, 2).HorizontalAlignment = xlLeft
End If
Cells(Row, 3) = Cell.Value
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 3).Font.ColorIndex = 3
Cells(Row, 3).Font.FontStyle = "Bold"
Cells(Row, 3).VerticalAlignment = xlCenter
Cells(Row, 3).HorizontalAlignment = xlCenter
End If
Row = Row + 1
End With
End If
Next Cell

--
Regards,
Tom Ogilvy


Phil Hageman said:
The below macro creates a worksheet and lists all formulas contained in the
target worksheet; however, it needs a tweak. Some worksheet formulas are
contained in a merged cell range and the output lists all the blank cells of
the range, as well as the one cell holding the formula. Is there a way to
modify the code to not list the blank cells of the range?


Sub ListFormulas()
'This code creates a new worksheet, lists cell addresses (column A),
'formulas (column B), and formula return values (column C).
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer

'Create a range object for all formula cells
On Error Resume Next
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)

'Exit if no formulas found
If FormulaCells Is Nothing Then
MsgBox "No Formulas, or, the worksheet is protected."
Exit Sub
End If

'Add a new worksheet
Application.ScreenUpdating = False
Set FormulaSheet = ActiveWorkbook.Worksheets.Add
FormulaSheet.Name = "Formulas in " & FormulaCells.Parent.Name

'Set up the column headings
With FormulaSheet
Range("A1") = "ADDRESS"
Range("B1") = "FORMULA"
Range("C1") = "VALUE"
Range("A1:C1").Font.Bold = True
Range("A1:C1").Font.ColorIndex = 5
Range("A1:C1").HorizontalAlignment = xlCenter
Range("A1:C1").Interior.ColorIndex = 19
End With
Range("A2").Select
ActiveWindow.FreezePanes = True

'Process each formula
Row = 2
For Each Cell In FormulaCells
Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
With FormulaSheet
Cells(Row, 1) = Cell.Address(RowAbsolute:=False,
ColumnAbsolute:=False)
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 1).Font.ColorIndex = 3
Cells(Row, 1).Font.FontStyle = "Bold"
Cells(Row, 1).VerticalAlignment = xlCenter
Cells(Row, 1).HorizontalAlignment = xlCenter
End If
Cells(Row, 2) = " " & Cell.Formula
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 2).Font.ColorIndex = 3
Cells(Row, 2).Font.FontStyle = "Bold"
Cells(Row, 2).VerticalAlignment = xlCenter
Cells(Row, 2).HorizontalAlignment = xlLeft
End If
Cells(Row, 3) = Cell.Value
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 3).Font.ColorIndex = 3
Cells(Row, 3).Font.FontStyle = "Bold"
Cells(Row, 3).VerticalAlignment = xlCenter
Cells(Row, 3).HorizontalAlignment = xlCenter
End If
Row = Row + 1
End With
Next Cell

'Adjust column widths
With FormulaSheet
.Columns("A:A").AutoFit
With .Columns("B:C")
.ColumnWidth = 45
.WrapText = True
End With
.Rows("1:1000").AutoFit
End With
FormulaSheet.Columns("A:C").AutoFit
Application.StatusBar = False

End Sub
Click to expand...
 
P

P Daulton

You beat me to it!
my offering in the same place:
If Cell.Address = Cell.MergeArea.Cells(1, 1).Address Then

Pascal


Tom Ogilvy said:
For Each Cell In FormulaCells
Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
If Left(cell(1).Formula,1) = "=" then [snip]


Phil Hageman said:
The below macro creates a worksheet and lists all formulas contained in the
target worksheet; however, it needs a tweak. Some worksheet formulas are
contained in a merged cell range and the output lists all the blank
Click to expand...
cells
of
the range, as well as the one cell holding the formula. Is there a way to
modify the code to not list the blank cells of the range?
Click to expand...
Click to expand...
 
G

Guest

Thanks, Tom - works as expected. Not sure, but I think you gave me this
macro a few years ago. Very useful. Again, thanks and have a Merry
Christmas.
Phil

Tom Ogilvy said:
For Each Cell In FormulaCells
Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
If Left(cell(1).Formula,1) = "=" then
With FormulaSheet
Cells(Row, 1) = Cell.Address(RowAbsolute:=False,
ColumnAbsolute:=False)
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 1).Font.ColorIndex = 3
Cells(Row, 1).Font.FontStyle = "Bold"
Cells(Row, 1).VerticalAlignment = xlCenter
Cells(Row, 1).HorizontalAlignment = xlCenter
End If
Cells(Row, 2) = " " & Cell.Formula
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 2).Font.ColorIndex = 3
Cells(Row, 2).Font.FontStyle = "Bold"
Cells(Row, 2).VerticalAlignment = xlCenter
Cells(Row, 2).HorizontalAlignment = xlLeft
End If
Cells(Row, 3) = Cell.Value
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 3).Font.ColorIndex = 3
Cells(Row, 3).Font.FontStyle = "Bold"
Cells(Row, 3).VerticalAlignment = xlCenter
Cells(Row, 3).HorizontalAlignment = xlCenter
End If
Row = Row + 1
End With
End If
Next Cell

--
Regards,
Tom Ogilvy


Phil Hageman said:
The below macro creates a worksheet and lists all formulas contained in the
target worksheet; however, it needs a tweak. Some worksheet formulas are
contained in a merged cell range and the output lists all the blank cells of
the range, as well as the one cell holding the formula. Is there a way to
modify the code to not list the blank cells of the range?


Sub ListFormulas()
'This code creates a new worksheet, lists cell addresses (column A),
'formulas (column B), and formula return values (column C).
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer

'Create a range object for all formula cells
On Error Resume Next
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)

'Exit if no formulas found
If FormulaCells Is Nothing Then
MsgBox "No Formulas, or, the worksheet is protected."
Exit Sub
End If

'Add a new worksheet
Application.ScreenUpdating = False
Set FormulaSheet = ActiveWorkbook.Worksheets.Add
FormulaSheet.Name = "Formulas in " & FormulaCells.Parent.Name

'Set up the column headings
With FormulaSheet
Range("A1") = "ADDRESS"
Range("B1") = "FORMULA"
Range("C1") = "VALUE"
Range("A1:C1").Font.Bold = True
Range("A1:C1").Font.ColorIndex = 5
Range("A1:C1").HorizontalAlignment = xlCenter
Range("A1:C1").Interior.ColorIndex = 19
End With
Range("A2").Select
ActiveWindow.FreezePanes = True

'Process each formula
Row = 2
For Each Cell In FormulaCells
Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
With FormulaSheet
Cells(Row, 1) = Cell.Address(RowAbsolute:=False,
ColumnAbsolute:=False)
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 1).Font.ColorIndex = 3
Cells(Row, 1).Font.FontStyle = "Bold"
Cells(Row, 1).VerticalAlignment = xlCenter
Cells(Row, 1).HorizontalAlignment = xlCenter
End If
Cells(Row, 2) = " " & Cell.Formula
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 2).Font.ColorIndex = 3
Cells(Row, 2).Font.FontStyle = "Bold"
Cells(Row, 2).VerticalAlignment = xlCenter
Cells(Row, 2).HorizontalAlignment = xlLeft
End If
Cells(Row, 3) = Cell.Value
If InStr(1, Cell.Formula, "[") > 0 Then
Cells(Row, 3).Font.ColorIndex = 3
Cells(Row, 3).Font.FontStyle = "Bold"
Cells(Row, 3).VerticalAlignment = xlCenter
Cells(Row, 3).HorizontalAlignment = xlCenter
End If
Row = Row + 1
End With
Next Cell

'Adjust column widths
With FormulaSheet
.Columns("A:A").AutoFit
With .Columns("B:C")
.ColumnWidth = 45
.WrapText = True
End With
.Rows("1:1000").AutoFit
End With
FormulaSheet.Columns("A:C").AutoFit
Application.StatusBar = False

End Sub
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Modification to code 1
Need Macro Modification 2
Need Formula Listing Code Modification 3
InputBox for column letter problem 2
Error with calling Format sub 7
Modify Recorded Macro 1
keep getting the error message - Compile error: Else without If 2
piece of code keeps failing.... 2

Top