Conditionally Format Specific words within cells of worksheet - excel

Question

I have data such that single cells contain multiple bit of info.
Using conditional formatting excel can recognise cells which contain a phrase however the conditional format is applied to the cell as a whole. I'm aiming to try and Highlight the Specific text "Not Provided" in Red.
Looking online it looks like this will be a VBA solution.
To start, I have found the following code online however this doesnt appear to change the colour as desired.
Sub Test1()
Dim strString$, x&
Dim rngCell As Range
strString = Range("B1").Value
Application.ScreenUpdating = False
For Each rngCell In Range("G1", Range("G" & Rows.Count).End(xlUp))
With rngCell
.Font.ColorIndex = 1
For x = 1 To Len(.Text) - Len(strString) Step 1
If Mid(.Text, x, Len(strString)) = strString Then .Characters(x, Len(strString)).Font.ColorIndex = 5
Next x
End With
Next rngCell
Application.ScreenUpdating = True
End Sub
If someone could point out either how I can get the code above working to explore if this will be useful for my purposes or even if someone knows how to conditionally format specific words that would be great. Ultimately I wish for every instance of "Not Provided" across the worksheet to be highlighted in this way.

Answer 1

You can use InStr() to find substring instead of For loop
Sub Test1()
Dim strString As String, x As Long, rngCell As Range
strString = Range("B1").Value
Application.ScreenUpdating = False
For Each rngCell In Range("G1", Range("G" & Rows.Count).End(xlUp))
x = InStr(1, rngCell.Value2, strString, vbTextCompare)
If x > 0 Then
With rngCell
.Font.ColorIndex = 1
.Characters(x, Len(strString)).Font.ColorIndex = 3 'red color
End With
End If
Next
Application.ScreenUpdating = True
End Sub
To dynamically change the color of the text, as in conditional formatting, you can use the Change event:
'place it into the Worksheet module
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strString As String, x As Long, rngCell As Range, rng As Range
Set rng = Intersect(Target, Me.Columns("G"))
If rng Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
strString = Range("B1").Value
For Each rngCell In rng
x = InStr(1, rngCell.Value2, strString, vbTextCompare)
If x > 0 Then
With rngCell
.Font.ColorIndex = 1
.Characters(x, Len(strString)).Font.ColorIndex = 3 'red color
End With
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub