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

CodePudding user response：

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"
    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

CodePudding user response：

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: