How do I use Change(byVal Target as Range) to check/change cell color

Question

My primary data entry is a Worksheet named "Master". I want to check in Range A2:A1000 when a word is entered. If it is "CBI", "Fire", "InCase" or "LEA" nothing needs to happen in Column I (Offset(0, 8)) as it already has a no-fill (Interior.ColorIndex = -4142). But, if any other word is entered in Range A2:A1000, Column I (Offset(0, 8)) is changed to a different color (Interior.Color = RGB(255, 231, 255)). I have selected the discrete worksheet with "Worksheet" and "Change" but cannot get the Intersect to function. I know the code is repetitive ... I would like to use multiple arguments, e.g., "CBI", "Fire", "InCase", "LEA" ... but it crashes at the firstIf Target line. Alternatively, a Select Case argument might be better. I have reviewed stackoverflow results on my search "run vba when cell change" and attempted to modify without success. I have also tried several coding attempts in the lone module where I have my other Subs which run fine, but help with this would be appreciated.

        Private Sub Worksheet_Change(ByVal Target As Range)

        'Change interior color in Offset cell if certain words not entered in Range A2:A1000

            If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then

                If Target(Range("A2:A1000"), "CBI") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
                If Target(Range("A2:A1000"), "Fire") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
                If Target(Range("A2:A1000"), "InCase") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
              If Target(Range("A2:A1000"), "LEA") > 0 Then
                    ActiveCell.Offset(0, 8).Interior.ColorIndex = -4142
            Else
                ActiveCell.Offset(0, 8).Interior.Color = RGB(255, 231, 255)
            End If
  
          End If

        End Sub

`Target(Range("A2:A1000"), "CBI")` is not valid syntax, just check the value of `Target` instead. — SJR, Dec 21 '21 at 12:53

VBasic2008 · Accepted Answer · 2022-01-05T23:51:00.153

0

Adjust Color Depending on Another Cell's Value

This will adjust the color of a cell in column I depending on the value manually entered (not by formula) in column A. If column A doesn't contain a value from a list, the cell in the same row of column I will get colored.
If you already have values in column A, you can simply select them and do a 'copy/paste', and the colors in column I will be updated.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const sCriteriaList As String = "CBI,Fire,InCase,LEA" ' no spaces!
    Const sfCellAddress As String = "A2"
    Const dCol As String = "I"
    Dim diColor As Long: diColor = RGB(255, 231, 255)
    
    Dim sfCell As Range: Set sfCell = Range(sfCellAddress)
    Dim scrg As Range: Set scrg = sfCell.Resize(Rows.Count - sfCell.Row + 1)
    Dim srg As Range: Set srg = Intersect(scrg, Target)
    If srg Is Nothing Then Exit Sub
    
    Dim sCriteria() As String: sCriteria = Split(sCriteriaList, ",")
    
    Dim drg As Range: Set drg = Intersect(srg.EntireRow, Columns(dCol))
    
    Dim durg As Range
    Dim r As Long
    
    For r = 1 To srg.Cells.Count
        If IsError(Application.Match(CStr(srg.Cells(r)), sCriteria, 0)) Then
            If durg Is Nothing Then
                Set durg = drg.Cells(r)
            Else
                Set durg = Union(durg, drg.Cells(r))
            End If
        End If
    Next r
    
    drg.Interior.Color = xlNone
    If Not durg Is Nothing Then
        durg.Interior.Color = diColor
    End If
 
End Sub

EDIT:

Your new idea requires changes in two lines:

    Const sCriteriaList As String = "*BI,*EA,*PD,*SO,*TF" ' no spaces!

        If Application.Count(Application _
                .Match(sCriteria, srg.Cells(r), 0)) = 0 Then

edited Jan 05 '22 at 23:51

answered Dec 21 '21 at 13:02

VBasic2008

44,888
5
17
28

Works perfect when as the whole ActiveCell.Value the diColor results. Can sCriteriaList be expanded to check the last 2 characters of the ActiveCell so diColor does not occur. E.G., ```Dim catend As String ... catend = Right(ActiveCell.Value, 2)```. So, if BI, EA, PD, SO or TF constitute catend (as in FBI, DEA, City PD, County SO, BATF), the diColor does not occur? (Had to rephrase the comment) – LawGuy Jan 05 '22 at 23:13
I've posted an edit at the bottom. – VBasic2008 Jan 05 '22 at 23:51
I tried ```Const sCriteriaList As String = "CBI,Fire,InCase,LEA",*BI,*EA,*PD,*SO,*TF"``` and replaced ```If srg Is Nothing Then Exit Sub``` with ``` If Application.Count(Appli...``` Didn't process. I am wanting both the original ```sCriteriaList``` and your edit. Are they as separate lines or in the same ```Const```? And, for the ```If Application``` . . . does it follow the ```Dim srg```? Confusted . . . but really am trying to understand. – LawGuy Jan 06 '22 at 00:13
Overnight thinking . . . all the would be necessary in the ```Const sCriteriaList As String``` would be InCase and the last 2 characters. I can eliminate CBI, Fire and LEA. The string would only need to be comprised of ```= "InCase, *BI,*EA,*FD,*PD,*SO,*TF"``` As you see the last 2 chars are of governmentt agencies and are inherently unique so they could be added to. I will keep trying to figure out where to put the ``` If Application.Count(Appli...``` coding, but your input is invaluble. – LawGuy Jan 06 '22 at 14:35
There's nothing to figure out: the line replaces the `If IsError... line` and add the additional strings (no spaces!) to the list. There is only one list: from double-quote to double-quote e.g. `"Fire,InCase,*BI,*EA,*PD,*SO,*TF"`. – VBasic2008 Jan 06 '22 at 15:13
I see. Trying to read too much into it. Thx. – LawGuy Jan 06 '22 at 16:24
VBasic2008 ... The code to color fill ColI based on ColA works like a charm. I have not, however, been able to figure out how to simultaneously color ColA's cell so both cells are color-filled. Same criteria, just that on entering ColA I would like it to assume color fill also. Can you assist? Thank you. – LawGuy Jun 20 '22 at 15:34

score 0 · Answer 2 · answered Dec 21 '21 at 14:07

0

This can so easily be done, using conditional formatting. I have created the following rule:

=AND(A2<>"CBI",A2<>"Fire",A2<>"InCase",A2<>"LEA")

And applied it on my "B" column, as you can see in this screenshot:

And this is the result:

answered Dec 21 '21 at 14:07

Dominique

16,450
15
56
112

How do I use Change(byVal Target as Range) to check/change cell color

2 Answers2

Adjust Color Depending on Another Cell's Value