View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Phil Hageman[_4_] Phil Hageman[_4_] is offline
external usenet poster
 
Posts: 81
Default List Formula Macro Needs Enhancement

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" wrote:

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" wrote in message
...
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