Sub LookingForNow()
[I][COLOR=#006400]'variables[/COLOR][/I]
Dim Sh As Worksheet, ws As Worksheet, Loc As Range, Addr1 As String, Dep As String, Addr As String, Formul As String
[COLOR=#006400][I]'results sheet[/I][/COLOR]
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Results " & Round(Timer, 0)
With ws.Range("A1:D1")
.ColumnWidth = 25
.Value = Split("Sheet,Ref,Formula,Dependents", ",")
.Font.Bold = True
End With
[I][COLOR=#006400]'loop sheets looking for "Now()"[/COLOR][/I]
For Each Sh In ThisWorkbook.Worksheets
On Error Resume Next
With Sh.UsedRange.SpecialCells(xlCellTypeFormulas)
Set Loc = .Cells.Find(What:="NOW()", LookAt:=xlPart)
On Error GoTo 0
On Error Resume Next
If Not Loc Is Nothing Then
Addr1 = Loc.Address
Do
Dep = Loc.Dependents.Address
Addr = Loc.Address(0, 0)
Formul = Replace(Loc.Formula, "=", "")
[I][COLOR=#006400] 'write results[/COLOR][/I]
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(Sh.Name, Addr, Formul, Dep)
Dep = ""
Set Loc = .FindNext(Loc)
Loop While Not Loc Is Nothing And Loc.Address <> Addr1
End If
End With
Set Loc = Nothing
Next Sh
End Sub