VBA conditional formatting (Excel 2003)

[PTD]

I've searched and seached, and haven't found the solution I'm looking for. I have 5 conditions, and as you know Excel only allows 3 conditional formats. I have little VBA experience, so I can't seem to create this on my own.

I'm trying to fill the color of a cell based on the value in different cells. Said differently, if the value in cell A1 = cell A42 then fill color green, if A1 = cell B42 then fill color red, and so on for 5 different reference points. The default would be to fill color black. Does anyone have some sample VBA code that will do something like this?

 

[blankus]

Hi Andrew

I have amended your code to read as follows and it works fine. However when I delete the details in column "M" i am getting an error run-time error '13' Type mismatch. Can you help me out please?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer

If Intersect(Target, Range("M16:M600")) Is Nothing Then Exit Sub
  
    
 'Blank List
   If Target.Value = Range("A7").Value Then
    r = Target.Row
    Range("J" & r).Interior.ColorIndex = 19 'Yellow
    Range("l" & r).Interior.ColorIndex = 19 'Yellow
      Exit Sub
   End If
 'Red List
   If Target.Value = Range("A8").Value Then
    r = Target.Row
    Range("J" & r).Interior.ColorIndex = 3 'Red
    Range("l" & r).Interior.ColorIndex = 3 'Red
      Exit Sub
   End If
   
 'Caution List
   If Target.Value = Range("A9").Value Then
   r = Target.Row
    Range("J" & r).Interior.ColorIndex = 46 'orange
    Range("l" & r).Interior.ColorIndex = 46 'orange
          Exit Sub
   End If
  
 'Green List
   If Target.Value = Range("A10").Value Then
   r = Target.Row
    Range("J" & r).Interior.ColorIndex = 50 'Green
    Range("l" & r).Interior.ColorIndex = 50 'Green
        Exit Sub
   End If
  
 'Blue List
   If Target.Value = Range("A11").Value Then
    r = Target.Row
    Range("J" & r).Interior.ColorIndex = 37 'Green
    Range("l" & r).Interior.ColorIndex = 37 'Green
      Exit Sub
   End If
 

End Sub

 

[blankus]

Hi Andrew

I have amended your code to read as follows and it works fine. However when I delete the details in column "M" i am getting an error run-time error '13' Type mismatch. Can you help me out please?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer

If Intersect(Target, Range("M16:M600")) Is Nothing Then Exit Sub
  
    
 'Blank List
   If Target.Value = Range("A7").Value Then
    r = Target.Row
    Range("J" & r).Interior.ColorIndex = 19 'Yellow
    Range("l" & r).Interior.ColorIndex = 19 'Yellow
      Exit Sub
   End If
 'Red List
   If Target.Value = Range("A8").Value Then
    r = Target.Row
    Range("J" & r).Interior.ColorIndex = 3 'Red
    Range("l" & r).Interior.ColorIndex = 3 'Red
      Exit Sub
   End If
   
 'Caution List
   If Target.Value = Range("A9").Value Then
   r = Target.Row
    Range("J" & r).Interior.ColorIndex = 46 'orange
    Range("l" & r).Interior.ColorIndex = 46 'orange
          Exit Sub
   End If
  
 'Green List
   If Target.Value = Range("A10").Value Then
   r = Target.Row
    Range("J" & r).Interior.ColorIndex = 50 'Green
    Range("l" & r).Interior.ColorIndex = 50 'Green
        Exit Sub
   End If
  
 'Blue List
   If Target.Value = Range("A11").Value Then
    r = Target.Row
    Range("J" & r).Interior.ColorIndex = 37 'Green
    Range("l" & r).Interior.ColorIndex = 37 'Green
      Exit Sub
   End If
 

End Sub

 

[Andrew Poulsom]

Maybe you need to add:

If Target.Count > 1 Then Exit Sub

or loop around the cells in Target if you want to work with more than one cell.

 

[blankus]

thanks....worked just fine