`Worksheet_Change` format cells containing specific strings

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

With that problem statement, you are better off with conditional formatting as @Nathan_Sav said. However change `MyRange = ActiveCell` to `Set MyRange = ActiveCell`. That will take care of the current error (but it does not solve the problem). — prextor, Jan 29 '19 at 12:56
Read the answers in this post to help with the logic behind the fix, https://stackoverflow.com/questions/5042379/in-vb6-what-is-the-difference-between-property-set-and-property-let — Nathan_Sav, Jan 29 '19 at 12:56
@Nathan_Sav I want to learn how to handle large data without using a `for loop` or `Conditional formatting`. I tried your suggestion and the error is gone but the code does not work as intended. — Nick, Jan 29 '19 at 12:59
@prextor Yes, you are right. It solves the error but does not solve the problem. — Nick, Jan 29 '19 at 13:01
You are not doing it right, after the change in `a1` you'll be in `a2` i.e. `Activecell` will then be A2, which meets your `=''` logic, you just need to use `target` Just use `target` rather than `MyRange` — Nathan_Sav, Jan 29 '19 at 13:06
@Nathan_Sav I used `Set MyRange = ActiveCell` like you suggested and there is no error now. However, the code is not working. — Nick, Jan 29 '19 at 13:06
@Nathan_Sav how to use the `target`? Could you please show it to me with an example. — Nick, Jan 29 '19 at 13:10
Already done, but clear in the time of response, you haven't tried yourself. Learning is better than just being given code :) — Nathan_Sav, Jan 29 '19 at 13:11

score 1 · Answer 1 · answered Jan 29 '19 at 13:08

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

answered Jan 29 '19 at 13:08

Nathan_Sav

8,466
2
13
20

The only problem now is that if I go on a cell where it was `Yes` and hit delete or backspace I get the following error: `Run-time error 13: Type mismatch` – Nick Jan 29 '19 at 13:18
I need to add something that will reset the cell conditions if a cell is blank i.e. `no color fill` and `font color` to black – Nick Jan 29 '19 at 13:20
In this case there is of course a problem with last else, just test my answer – Rafał B. Jan 29 '19 at 13:23

CLR · Accepted Answer · 2019-01-29T13:26:43.217

0

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:

edited Jan 29 '19 at 13:26

answered Jan 29 '19 at 13:05

CLR

11,284
1
11
29

Works fine on my machine. Tested by copying word Yes from a cell outside the A1:A10 range and pasting it into A2:C7. Cells A2:A7 are highlighted. – CLR Jan 29 '19 at 13:23
Yes. It works that way. Now, in your example please select cells from A2:A7 and hit `delete`. Then you should get a `mismatch error` – Nick Jan 29 '19 at 13:32
Also, I have tested this by deleting several cells at once. Behaves correctly. – CLR Jan 29 '19 at 13:33
It works now. I used a new excel sheet and tried it again. – Nick Jan 29 '19 at 13:37
Could you please explain to me the for loop which you have inserted. How does it work? – Nick Jan 29 '19 at 13:39
Sure. It works like a `Set` statement, but cycling through each of the objects after the `In`. So in this case, it's a `For..Next` loop that instead of just incrementing an integer, it's `Set`ting `MyRange` to each `Cell` in the range intersection - i.e. the cells of `Target` intersecting with the cells of `KeyCells`. – CLR Jan 29 '19 at 14:55
You can use it to cycle through each cell in a range like `Selection` for instance, with: `For each c in Selection.Cells : Debug.Print c.Address : Next` – CLR Jan 29 '19 at 14:58

Rafał B. · Answer 3 · 2019-01-29T13:21:53.150

0

  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

edited Jan 29 '19 at 13:21

answered Jan 29 '19 at 13:09

Rafał B.

487
1
3
19

I select two cells containing `Yes` and `No` respectively and hit `delete` then I get the following error: `Run-time error 13: Type mismatch` – Nick Jan 29 '19 at 13:29
If you want to modify multiple cells at once you should use CLR answer, just modify last Else in his code if you want to get another results – Rafał B. Jan 29 '19 at 13:33

score 0 · Answer 4 · answered Jan 29 '19 at 13:28

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

Since it's not a `Private Sub` that means I have to run this macro of yours everytime I add a new value to the cell. Is this the case? — Nick, Jan 29 '19 at 13:34
Yes, as it is currently written. However you could always fashion it into a sheet macro selection-change function that would run every time a user types something into a target range, but conditional formatting would be so much easier. Why do you not wish to use conditional formatting? I don't know. I'm just guessing at why. Are your ranges to search changing? Are there so many that it would be time consuming to condition them? This is just an alternative. Also, you can make it a private sub. It still needs to be run every time a change is made, just like conditional formatting. — John Muggins, Jan 29 '19 at 13:44

`Worksheet_Change` format cells containing specific strings

4 Answers4