I have this statement in excel cell B12 which is actually the resultant value of a very complex excel formula: "● Up to January 23, 2024 - The national mean monthly temperature was 10.12 °C, being -0.86 °C cooler than monthly area-averaged temperature of 10.98 °C and slightly decreasing. ↓ "
Now, I want to change the color of "cooler" and "slightly decreasing" text to blue. I have developed a VBA code but it is running on a cell which contains only values
and it is not running on the cell containing excel formula.
My VBA code is given below:
Sub HighlightKeywordsDynamically()
Dim rngCell As Range
Dim newText As String
Dim keywordPos As Long
Dim keyword As String
Dim i As Integer
' Set the target range from B392 to B412
Set rngCell = Range("B392:B412")
' Arrays of keywords and their corresponding colors
Dim blueKeywords As Variant
blueKeywords = Array("slightly decreasing", "significantly decreasing", "sharply decreasing", "below average", "coldest place", "coldest night", "coldest day", "smallest diurnal", "cooler")
Dim redKeywords As Variant
redKeywords = Array("slightly increasing", "significantly increasing", "sharply increasing", "above average", "hottest place", "hottest night", "hottest day", "largest diurnal", "warmer")
' Loop through each cell in the range
For Each cell In rngCell
' Get the formula text from the cell
newText = cell.Formula
' Loop through blue keywords
For i = LBound(blueKeywords) To UBound(blueKeywords)
keyword = blueKeywords(i)
keywordPos = InStr(1, newText, keyword, vbTextCompare)
If keywordPos > 0 Then
' Check for specific keywords to apply the logic of 9 characters before
If keyword = "cooler" Then
cell.Characters(Start:=keywordPos - 9, Length:=Len(keyword) + 9).Font.Color = RGB(0, 0, 255) ' Blue
Else
cell.Characters(Start:=keywordPos, Length:=Len(keyword)).Font.Color = RGB(0, 0, 255) ' Blue
End If
End If
Next i
' Loop through red keywords
For i = LBound(redKeywords) To UBound(redKeywords)
keyword = redKeywords(i)
keywordPos = InStr(1, newText, keyword, vbTextCompare)
If keywordPos > 0 Then
' Check for specific keywords to apply the logic of 9 characters before
If keyword = "warmer" Then
cell.Characters(Start:=keywordPos - 9, Length:=Len(keyword) + 9).Font.Color = RGB(255, 0, 0) ' Red
Else
cell.Characters(Start:=keywordPos, Length:=Len(keyword)).Font.Color = RGB(255, 0, 0) ' Red
End If
End If
Next i
Next cell
End Sub
I have developed VBA code which is running on cells containing text. I need suggestions or modifications in code to bring out the desired results on the resultant values of formulas
You can use the Change
and BeforeDoubleClick
(or BeforeRightClick
) routines to hide a formula in a note.
When you edit a formula in a cell and commit the edit, the Change
procedure copies the formula to the note and leaves the value in the cell.
You can now format this value with your routine (adjusted to a single cell).
When you use DoubleClick
on a cell that previously had a formula and was stored, it is restored so that you can edit it. After committing, there will be a value in the cell again and the formula will go to the note.
The disadvantage of this is that if you use relative references in formulas, the references (stored in a note) do not react as they would when copying formulas. If you want to perform such copies, you need to disable the Change
event handler for the time being.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Comment Is Nothing Then Exit Sub
Application.EnableEvents = False
If .Comment.Text Like "=*" Then _
.Formula = .Comment.Text
Application.EnableEvents = True
.Comment.Delete
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .CountLarge > 1 Then Exit Sub
If .HasFormula Then
On Error Resume Next
.AddComment
On Error GoTo 0
.Comment.Visible = False
.Comment.Text Text:=.Formula
.Comment.Shape.TextFrame.AutoSize = True
Application.EnableEvents = False
.Value = .Value
Application.EnableEvents = True
' here goes a procedure to display text with characters' formatting
Else
If Not .Comment Is Nothing Then _
.Comment.Delete
End If
End With
Application.DisplayCommentIndicator = xlNoIndicator
End Sub
Here you can download the file and make a local copy.Formula_In_Note