Identify Unique Formula's

[ra]

Hello,

I am performing a model review and would like some code to highlight
and identify Unique formula's.

I used below to identify all formulas, but would idealy like only like
the unique formulas per row to be highlighted.

Any idea's??

Selection.SpecialCells(xlCellTypeConstants, 21).Select
Selection.Interior.ColorIndex = 40
Selection.Font.ColorIndex = 0

regards
Ra

 

[RB Smissaert]

Try this:

Sub ShowUniqueFormulas(rng As Range)

Dim rngCell As Range
Dim strTest As String

For Each rngCell In rng
If InStr(1, strTest, rngCell.Formula, vbBinaryCompare) = 0 And _
Len(rngCell.Text) > 0 Then
strTest = strTest & "|" & rngCell.Formula
rngCell.Interior.ColorIndex = 27
Else
rngCell.Interior.ColorIndex = xlNone
End If
Next

End Sub


Sub test()

ShowUniqueFormulas Range(Cells(1), Cells(256))

End Sub


RBS

 

[ra]

Thanks RBS, that has provided a good start

It now highlights all cells that are different, however ideally I do
not mind if the result (value) is different just if the underlying
formula is. For example if a formula has been copied accross row 3 say
from column A to D and then a new formula is entered from column E- I
want (if possible) the code to highlight cell A3 and then the new
formula cell in column E3.

I hope that makes sense!
cheers Ra

 

[ra]

Thanks RBS, that has provided a good start

It now highlights all cells that are different, however ideally I do
not mind if the result (value) is different just if the underlying
formula is. For example if a formula has been copied accross row 3 say
from column A to D and then a new formula is entered from column E- I
want (if possible) the code to highlight cell A3 and then the new
formula cell in column E3.

I hope that makes sense!
cheers Ra

 

[RB Smissaert]

I think then you will need to use R1C1 reference style formula's, so for
example = RC[-1] instead of = A1
etc.
The other option is to manipulate the formula string
by only leaving in bits that can't refer to a range, but that
gets a bit complex.

RBS

 

[ra]

Hi RBS,
The model's I review are in the creator's format, so I need to be able
to handle both A1 and R1C1 type formats.
However as you suggest maybe the first step is to convert all
formula's to this style. I will give that a go!

 

[ra]

Thanks RBS, the below code works. -One improvement I need to work on
is to treat each row individually within selection, so it highlights
unique formulas per row rather than per sheet...

Sub Audit_Tool_1()

'Highlights Unique formula's within total selection
Dim rngCell As range, rng As range
Dim strTest As String
Set rng = Application.InputBox(prompt:="Select Range to be evaluated",
Type:=8)

For Each rngCell In rng
If InStr(1, strTest, rngCell.FormulaR1C1, vbBinaryCompare) = 0 And
_
Len(rngCell.Text) > 0 Then
strTest = strTest & "|" & rngCell.FormulaR1C1
rngCell.Interior.ColorIndex = 27
Else
rngCell.Interior.ColorIndex = xlNone
End If
Next
'Highlight Constants (hardcoded) Cells *Note: does not include
constants that contain = (equals)
' E.g. will pick up entry of "30,000" but not "=30,000"
On Error GoTo NotFound
rng.SpecialCells(xlCellTypeConstants, 21).Select
Selection.Interior.ColorIndex = 40
Selection.Font.ColorIndex = 0

' Exit Sub
NotFound:
MsgBox "Finished"


End Sub

 

[RB Smissaert]

One improvement I need to work on

is to treat each row individually within selection

Try this:

Sub Audit_Tool_1()

'Highlights Unique formula's within total selection
Dim rngCell As Range, rng As Range
Dim strTest As String
Dim lLastRow As Long

Set rng = Application.InputBox(prompt:="Select Range to be evaluated",
Type:=8)

For Each rngCell In rng
If rngCell.Row <> lLastRow Then
strTest = ""
End If
If InStr(1, strTest, rngCell.FormulaR1C1, vbBinaryCompare) = 0 And _
Len(rngCell.Text) > 0 Then
strTest = strTest & "|" & rngCell.FormulaR1C1
rngCell.Interior.ColorIndex = 27
Else
rngCell.Interior.ColorIndex = xlNone
End If
lLastRow = rngCell.Row
Next

'Highlight Constants (hardcoded) Cells *Note: does not include
'constants that contain = (equals)
' E.g. will pick up entry of "30,000" but not "=30,000"
On Error GoTo NotFound
rng.SpecialCells(xlCellTypeConstants, 21).Select
Selection.Interior.ColorIndex = 40
Selection.Font.ColorIndex = 0

' Exit Sub
NotFound:
MsgBox "Finished"

End Sub


RBS

 

[ra]

That worked a treat. Thanks again!