How to apply/change color to partial text in a cell from the resultant excel formula in VBA?

Question

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

Answer 1

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