Hi Jim,

Try this slightly revised and commented version:

'=================
Sub ConstantsInFormulas2()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim Rng2 As Range
Dim rCell As Range
Dim aCell As Range
Dim arr As Variant
Dim sStr As String
Dim strName As String
Dim msg As String
Dim i As Long
Dim iCtr As Long

Set WB = ActiveWorkbook '<<======== CHANGE
Set SH = WB.Sheets("Sheet1") '<<======== CHANGE
Set rng = SH.UsedRange '<<======== CHANGE

On Error Resume Next '\\ In case no formulas!
Set rng = rng.SpecialCells(xlFormulas)
On Error GoTo 0

arr = Array("/", "~*", "+", "-", "", "<", "=", "^", "[*]", "(")

If Not rng Is Nothing Then
For Each rCell In rng.Cells
For i = LBound(arr) To UBound(arr)
sStr = "*" & arr(i) & "[0-9]*"
If rCell.Formula Like sStr Then
If Not Rng2 Is Nothing Then
Set Rng2 = Union(Rng2, rCell)
Else
Set Rng2 = rCell
End If
End If
Next i
Next rCell
Else
'\\No formulas found
End If

If Not Rng2 Is Nothing Then
'\\ do something e.g.:
Debug.Print Rng2.Address
'\\ Highlight Formulas with constants
Rng2.Interior.ColorIndex = 6

'\\ Add a report sheet
Sheets.Add
'\\ Name the report sheet -include Report date & time
strName = "FormulasReport" _
& Format(Now, "yyyymmdd hh-mm")
ActiveSheet.Name = strName

For Each aCell In Rng2.Cells
iCtr = iCtr + 1
'\\ Write information to the Report sheet
With ActiveSheet
.Cells(iCtr, "A") = aCell.Address(external:=True)
.Cells(iCtr, "B") = "'" & aCell.Formula
End With
Next aCell

ActiveSheet.Columns("A:B").AutoFit

'\\ Parse address string to produce columnar MsgBox report
'\\ N.B. A Msgbox is limited to 255 characters.
msg = "Cells holding formulas which include constants" _
& vbNewLine
msg = msg & Replace(Rng2.Address(0, 0), ",", Chr(10))

Else
msg = "No Formula constants found in " & SH.Name
End If

MsgBox prompt:=msg, _
Buttons:=vbInformation, _
Title:="Formulas Report"

End Sub
'<<=================


---
Regards,
Norman



"Jim May" wrote in message
news:QHc8f.4854$mV4.3704@dukeread02...
Thanks VERY much Norman;
This is a real "Keeper"!!
Jim