VBA Code To find Hardcoded Values in Formula

[anjohn]

Hello,

I am struggling to create/find a procedure that will find hard coded
values in formula. So far I have been using code that searches for
special cells e.g. GoTo Specials cells for constants with Number and
Text. However I can not find a way of selecting cells which are part
refering to another cell and part refering to a hardcoded value or a
formula that just refers to a hardcoded value i.e. a formula with no
precedents.

Examples of formula I can not automatically select:

=A1+1
=1+2
=1+A1+H78*J80+9+K7

The formulas above contain a hardcoded value and its cells that contain
this type of formula I want to automatically select without selecting
every formula in the worsksheet.

Hope People can help

Best Regards

Anjohn

 

[Guest]

This is quite a hard task and you need to search through all the cells
parsing the values checking for the 'hard coded' values.

It is really not a simple task but what you do is

for each c in activesheet.cells
if ' 1 check if hard coded if is then
' add to selection
' or color cell
end if
next

Sorry can't help any more.

 

[Norman Jones]

Hi Anjohn,

Try:

'=================>>
Public 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
'<<=================

 

[Guest]

Norman,
WOW, fantastic

 

[anjohn]

Norman,

That is amazing!!

I didn't think about searching for the characters needed for constant
to be included in formula.

Thanks again Norman

Anjohn :

 

[dinga]

Norman,

That is awesome!

If anyone is still looking at this post, can some one help me? I want to use this approach to:
1. create a sheet that lists all the values but with a third column that adds the value (if there is more than 1 value in a formula then the new sheet would contain a row for each value)
2. amend the formula to refer to the cell on the new sheet which contains the value.

Effectively this will create a sheet of inputs.

Thanks
Dinga