Conditional Formatting 6 conditions

[Brian from Maui]

Aloha,

Can anyone write a code that highlights a row a different color. As an example. Range is A2:K100. If A2="Criteria 1" color A2:K2 green. If A2="Criteria 2" color A2:K2 yellow...etc etc.

TIA

 

[jindon]

Somthing like this

Sub test()
Dim myColor As Integer, r As Range
For Each r In Range("a2:a100")
     myColor = xlNone
     Select Case r.Value
          Case "Criteria1"
               myColor = 4
          Case "Criteria2"
               myColor = 6
          Case "Criteria3"
               myColor = 3
          Case "myCriteria4"
               myColor = 7
          Case myCriteria5"
               myColor = 14
          Case "myCriteria6"
               myColor = 19
     End Select
     r.Resize(,11).Interior.ColorIndex = myColor
Next
End Sub

 

[Von Pookie]

Untested, but something along these lines should work:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Variant

If Intersect(Target, [A2:A100]) Is Nothing Then Exit Sub

Select Case Target.Value
    Case Is = "Criteria 1"
        c = 'colorindex for green (don't know it off the top of my head)
    Case Is = "Criteria 2"
        c = 6 'colorindex for yellow
    Case Else 'if the value of the cell doesn't match any of the above cases
        c = xlNone 'no color
End Select

'change color of A:K of the current row
Range(Target, Target.Offset(0, 10)).Interior.ColorIndex = c

End Sub

 

[Brian from Maui]

It doesn't fire. I tried entering in a module worksheet and workbook. Nothing fires. To clarify. My range is A2:K100. If A2="a", color A2:K2 red.

If A3 is "b", color A3:K3 blue and so on for six criterias.

 

[Von Pookie]

The code Jindon posted does not fire automatically--you have to run it yourself.

The code I posted is a Worksheet_Change event, so it would need to go in the module of the sheet you want it to work on. As posted, it is written so that it will only fire if you make a change in A2:A100, and will not be triggered if the values are changing due to formulas in them--it has to be a manual change. To trigger a macro from a formula result, you can use a Calculate event instead of Change event.

 

[Brian from Maui]

Untested, but something along these lines should work:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Variant

If Intersect(Target, [A2:A100]) Is Nothing Then Exit Sub

Select Case Target.Value
    Case Is = "Criteria 1"
        c = 'colorindex for green (don't know it off the top of my head)
    Case Is = "Criteria 2"
        c = 6 'colorindex for yellow
    Case Else 'if the value of the cell doesn't match any of the above cases
        c = xlNone 'no color
End Select

'change color of A:K of the current row
Range(Target, Target.Offset(0, 10)).Interior.ColorIndex = c

End Sub

Thanks Kristy, that works....

 

[jindon]

Yeah, because I didn't know if the cells are changed by manually or formula...
To the sheet module
If you are changing manually

Private Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a2:a100")) Is Nothing Then test
End Sub

If by the formula then

Private Sub Worksheet_Calculate()
test
End Sub

 

[Brian from Maui]

Yeah, because I didn't know if the cells are changed by manually or formula...
To the sheet module
If you are changing manually

Private Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a2:a100")) Is Nothing Then test
End Sub

If by the formula then

Private Sub Worksheet_Calculate()
test
End Sub

Thanks Jindon!

 

[Brian from Maui]

Jindon,

Like this????

Private Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a2:a100")) Is Nothing Then test
End Sub
For Each r In Range("a2:a100")
     myColor = xlNone
     Select Case r.Value
          Case "a"
               myColor = 4
          Case "b"
               myColor = 6
          Case "Criteria3"
               myColor = 3
          Case "myCriteria4"
               myColor = 7
          Case "myCriteria5"
               myColor = 14
          Case "myCriteria6"
               myColor = 19
     End Select
     r.Resize(, 11).Interior.ColorIndex = myColor
Next
End Sub

 

[jindon]

Change like this, so that it will run correctly when you paste/change the multiple data at a time.

Private Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a2:a100")) Is Nothing Then _
       test Intersect(Target, Range("a2:a100"))
End Sub

Sub test(ByVal rng As Range)
Dim r As Range, myColor As Integer
For Each r In rng
     myColor = xlNone
     Select Case r.Value
          Case "a"
               myColor = 4
          Case "b"
               myColor = 6
          Case "Criteria3"
               myColor = 3
          Case "myCriteria4"
               myColor = 7
          Case "myCriteria5"
               myColor = 14
          Case "myCriteria6"
               myColor = 19
     End Select
     r.Resize(, 11).Interior.ColorIndex = myColor
Next
End Sub