Constant in Formula

[Norman Jones]

Hi Sige,

Try:

'=================>>
Sub HighlightConstantFormulae(Optional aColor As Long = 6)
Dim rng As Range
Dim rng2 As Range
Dim rCell As Range
Dim arr As Variant
Dim sStr As String
Dim i As Long

arr = Array("/", "~*", "+", "-", ">", "<", "=", "^", "[*]", "(")
On Error Resume Next 'In case no formulas!
Set rng = ActiveSheet.UsedRange.SpecialCells(xlFormulas)
On Error GoTo 0

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

With rng2
.FormatConditions.Delete
If aColor > 0 Then
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = aColor
End If
End With

End Sub
'<<=================
'=================>>
Sub Toggle()
Static aColor As Long

aColor = IIf(aColor = 6, 0, 6)
HighlightConstantFormulae aColor

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

 

[Norman Jones]

Hi Sige,

I should add, that the suggested code assumes that the previous coloring is
not the result of conditional formatting.

---
Regards,
Norman

Hi Sige,

Try:

'=================>>
Sub HighlightConstantFormulae(Optional aColor As Long = 6)
Dim rng As Range
Dim rng2 As Range
Dim rCell As Range
Dim arr As Variant
Dim sStr As String
Dim i As Long

arr = Array("/", "~*", "+", "-", ">", "<", "=", "^", "[*]", "(")
On Error Resume Next 'In case no formulas!
Set rng = ActiveSheet.UsedRange.SpecialCells(xlFormulas)
On Error GoTo 0

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

With rng2
.FormatConditions.Delete
If aColor > 0 Then
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = aColor
End If
End With

End Sub
'<<=================
'=================>>
Sub Toggle()
Static aColor As Long

aColor = IIf(aColor = 6, 0, 6)
HighlightConstantFormulae aColor

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


---
Regards,
Norman

Hi Norman,

Thanks again. It works fine ...but I was more looking for a Ctrl
+z-function.

I do not know whether this is easy ?!

Sige

 

[Sige]

No Previous coloring is not conditional formatting!

Sige

 

[Sige]

It is magnificent!

It's just that my previous color cell is gone ... (possible conditional
formattting remains un-touched)

Sige

 

[Sige]

Ooops,
Did not say anything ...missed this one out!
Wonderful wonderful!



With rng2
.FormatConditions.Delete
If aColor > 0 Then
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = aColor
End If
End With

 

[Sige]

Norman,

Could it be tested that rng has conditional formatting ...?

if TRUE then
msgbox Current conditional formatting will be deleted, continue?
vbYesNo

Sige

 

[Norman Jones]

Hi Sige,

Try:
'=================>>
Sub HighlightConstantFormulae(Optional aColor As Long = 6)
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rCell As Range
Dim arr As Variant
Dim sStr As String
Dim i As Long
Dim res As Long
Static blCFdeleted

arr = Array("/", "~*", "+", "-", ">", "<", "=", "^", "[*]", "(")
On Error Resume Next 'In case no formulas!
Set rng = ActiveSheet.UsedRange.SpecialCells(xlFormulas)
On Error GoTo 0

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

On Error Resume Next
Set rng3 = _
rng2.SpecialCells(xlCellTypeAllFormatConditions)
On Error GoTo 0

If Not rng3 Is Nothing Then
If Not blCFdeleted Then
res = MsgBox("Current conditional formatting will be " & _
"deleted, continue?", _
Buttons:=vbYesNo)
End If
End If

If res = vbYes Then aColor = 6

If Not res = vbNo Then
With rng2
.FormatConditions.Delete
blCFdeleted = True
If aColor > 0 Then
.FormatConditions.Add Type:=xlExpression, _
Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = aColor
End If
End With
End If

End Sub
'--------------------------------

Sub Toggle()
Static aColor As Long

aColor = IIf(aColor = 6, 0, 6)
HighlightConstantFormulae aColor

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

 

[Sige]

Hi Norman,

So far the enhancements!
For me this is an EXTREMELY useful tool....
I ll put it in my personal add-in!

I don't think you have a personal website ... (do you?) but if you get
one, put it on!
A lot of controllers, planners,... and other number crunchers will
benefit from it!

Deep bow,
Sige