Macro Auto-refresh?

[Marty Reinders]

I used the attached macro to list all formulas in a work-
book. When I change any Formula, I have to re-run the
macro to update the formula list. Is there any way to do
this automatically?

Thanks,

Marty
Public Sub doFormula()

Dim bSaved As Boolean
Dim sWS As String

'Displays a list of formulae and named ranges used in
the workbook
Dim wks As Worksheet
Dim bHasFormula As Boolean
Dim i As Integer
Dim Cell As Range

'Switch off screen updating to improve performance
Application.ScreenUpdating = False

'UnprotectWS
With ActiveSheet
'Unprotect and clear the worksheet
.UsedRange.Delete xlShiftUp
bHasFormula = False

Range("A1").Value = "Worksheet"
Range("B1").Value = "Formula"
Range("C1").Value = "Range"
Range("D1").Value = "Protected"
Range("A11").Font.Bold = True

'Check if the workbook contains any formulae
For Each wks In ThisWorkbook.Worksheets
If wks.UsedRange.HasFormula = False Then
Else
bHasFormula = True
Exit For
End If
Next wks

If bHasFormula = False Then

'If false display message in cell C1
.Range("B2").Value = "This Workbook contains
no formulae."
i = 2
Else

'If true build the formulae list
i = 2

'Check each cell on each sheet for formulae
For Each wks In ThisWorkbook.Worksheets
For Each Cell In wks.UsedRange.Cells
If Cell.HasFormula = True Then
'If the cell has a formula record
the worksheet
'name, cell address and cell formula
.Cells(i, 1).Value = wks.Name
.Cells(i, 2).Value = "'" &
Cell.Formula
.Cells(i, 3).Value = Cell.Address
(RowAbsolute:=False, ColumnAbsolute:=False)
.Cells(i, 4).Value = Cell.Locked

'Increment the row counter
i = i + 1
End If
Next Cell
Next wks
End If

i = i + 2
'Check if the workbook contains Names
.Cells(i, 1).Value = "Name"
.Cells(i, 1).Font.Bold = True
.Cells(i, 2).Value = "Refers to"
.Cells(i, 2).Font.Bold = True

If ThisWorkbook.Names.Count > 0 Then
'If true display a list of Names
.Cells(i + 1, 1).ListNames
Else
.Cells(i + 1, 2).Value = "This Workbook
contains no named ranges. "

End If

'Format the list
With .Columns("A:A")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
End With

With .Columns("B:B")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.ColumnWidth = 70
.WrapText = True
.Cells.EntireRow.AutoFit
End With

Range("A1").Select
End With

'Switch screen updating back on
Application.ScreenUpdating = True
Exit Sub
End Sub

Sub PrintCommentsByColumn()
'David McRitchie, misc, 2002-08-09, corrected 2002-08-10
'reference:
http://www.mvps.org/dmcritchie/excel/ccomments.htm
Dim Cell As Range
Dim myrange As Range, myrangeC As Range
Dim col As Long
Dim RowOS As Long
Dim wsSource As Worksheet
Dim wsNew As Worksheet
If ActiveSheet.Comments.Count = 0 Then
MsgBox "No comments in entire sheet"
Exit Sub
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'xl95 uses
xlManual
Set wsSource = ActiveSheet
Sheets.Add
Set wsNew = ActiveSheet
wsSource.Activate
With wsNew.Columns("A:C")
.VerticalAlignment = xlTop
.WrapText = True
End With
wsNew.Columns("B").ColumnWidth = 15
wsNew.Columns("C").ColumnWidth = 60
wsNew.PageSetup.PrintGridlines = True
RowOS = 2
wsNew.Cells(1, 3) = "'" &
Application.ActiveWorkbook.FullName & " -- " & _
Application.ActiveSheet.Name
For col = 1 To ActiveSheet.UsedRange.Columns.Count
Set myrangeC = Intersect(ActiveSheet.UsedRange,
Columns(col), _
Cells.SpecialCells(xlCellTypeComments))
If myrangeC Is Nothing Then GoTo nxtCol
For Each Cell In myrangeC
If Trim(Cell.Comment.Text) <> "" Then
RowOS = RowOS + 1
wsNew.Cells(RowOS, 1) = "'" & Cell.Address(0,
0) & ":"
wsNew.Cells(RowOS, 2) = "'" & Cell.Text
wsNew.Cells(RowOS, 3) = "'" & Cell.Comment.Text
End If
Next Cell
nxtCol:
Next col
wsNew.Activate
Application.Calculation = xlCalculationAutomatic 'xl95
uses xlAutomatic
Application.ScreenUpdating = True
End Sub