`Worksheet_Change` format cells containing specific strings - excel

Question

I would like to use vba to carry out conditional formatting.
I want to format cell backround containing string Yes with green and red for string No. Earlier, I used a For loop but since the data is huge the algorithm takes a lot of time and excel becomes non responsive.
Then I tried to use Private Sub Worksheet_Change(ByVal Target As Range) to detect the change in cell and to apply colors to it but it does not work as it is supposed to.
This is what I have tried so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
Dim KeyCells As Range
Set KeyCells = Range("A1:A10")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Set MyRange = ActiveCell
MyRange.Select
If MyRange.Value = "Yes" Then
MyRange.Interior.ColorIndex = 35
MyRange.Font.ColorIndex = 50
ElseIf MyRange.Value = "No" Then
MyRange.Interior.ColorIndex = 22
MyRange.Font.ColorIndex = 9
Else
MyRange.Value = ""
MyRange.Interior.ColorIndex = xlNone
MyRange.Font.ColorIndex = 1
End If
End If
End Sub

Answer 1

In support of my comment, here is the fix
Private Sub Worksheet_Change(ByVal target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1:A10")
If Not Application.Intersect(KeyCells, Range(target.Address)) _
Is Nothing Then
If target.Value = "Yes" Then
target.Interior.ColorIndex = 35
target.Font.ColorIndex = 50
ElseIf target.Value = "No" Then
target.Interior.ColorIndex = 22
target.Font.ColorIndex = 9
Else
target.Value = ""
target.Interior.ColorIndex = xlNone
target.Font.ColorIndex = 1
End If
End If
End Sub

Answer 2

You need to be aware that a change can be made to more than one cell at once. E.g. If user pastes a value into a range - or selects a range and then deletes.
To work around this, you cycle through each cell in the changed area.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
Dim KeyCells As Range
Set KeyCells = Range("A1:A10")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Application.EnableEvents = False
For Each MyRange In Application.Intersect(KeyCells, Range(Target.Address)).Cells
If MyRange.Value = "Yes" Then
MyRange.Interior.ColorIndex = 35
MyRange.Font.ColorIndex = 50
ElseIf MyRange.Value = "No" Then
MyRange.Interior.ColorIndex = 22
MyRange.Font.ColorIndex = 9
Else
MyRange.Value = ""
MyRange.Interior.ColorIndex = xlNone
MyRange.Font.ColorIndex = 1
End If
Next
Application.EnableEvents = True
End If
End Sub
Testing:

Answer 3

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
Dim KeyCells As Range
Set KeyCells = Range("A1:A10")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
With Target
If .Value = "Yes" Then
.Interior.ColorIndex = 35
.Font.ColorIndex = 50
ElseIf .Value = "No" Then
.Interior.ColorIndex = 22
.Font.ColorIndex = 9
ElseIf .Value = "" Then
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
End If
End With
End If
End Sub

Answer 4

If your cells to check will always be A1:A10, or some other range that will never change, then I agree that conditional formatting is the way to go. If you have several columns to check and they are not always static, then building a find function might be easier. Here is one that you can send a range to and the text you are searching for:
Sub testFindAndColor()
Dim bg1 As Long, bg2 As Long
Dim fg1 As Long, fg2 As Long
Dim myRange As Range
Dim stringToFind As String
bg1 = 50: bg2 = 9
fg1 = 35: fg2 = 22
Set myRange = ActiveSheet.Range("A1:A30")
stringToFind = "Yes"
Run findAndColorize(myRange, stringToFind, bg1, fg1)
Set myRange = Nothing
End Sub
Function findAndColorize(myRange As Range, textToSearchFor As String, backLongColor As Long, foreLongColor As Long)
Dim newRange As Range
With myRange
Set c = .Find(textToSearchFor, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = backLongColor
c.Font.ColorIndex = foreLongColor
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Set c = Nothing
End Function