Solved

Excel 2003 VBA conditional color formatting

Posted on 2010-08-20
12
325 Views
Last Modified: 2013-11-25
I have a workbook that I have conditional formatting set up in. Everything is working great, but now the client wants some of the formatting to be based on the content of 2 cells instead of one.

In the attached workbook, on the 1st worksheet ("Benchmarks"),
column D needs to be colorindex38 if column C is 0(not blank),
 it needs to be colorindex 40 if column C is 40,
 it needs to be colorindex36 if column C is 50,
it needs to be colorindex 37 if column C is 70 or above AND.....
here's the real problem....
if column C is 60 AND column D is below 94, the cell in column D needs to be yellow
if column C is 60 AND column D is >93, the cell in column D needs to be green

*The code snippet I've attached below is the portion I currently have set up for the conditional formatting
Sub BenchmarksFormatting(rg As Range)
Dim Target As Range
Dim FillColors As Variant, v As Variant
FillColors = Array(38, 40, 36, 35, 37)
With rg.Worksheet
    For Each Target In rg.Cells
        If Target <> "" And IsNumeric(Target) Then
            If Not Intersect(Target, .Range("C4:C41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("E4:E41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("F4:F41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("G4:G41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("H4:H41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("I4:I41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("K4:K41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("M4:M41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("N4:N41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("O4:O41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("P4:P41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("Q4:Q41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("S4:S41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("U4:U41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("V4:V41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("W4:W41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("X4:X41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("Y4:Y41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
        End If
   Next
End With
End Sub

Open in new window

SWE-10-11-Benchmarks-6th.xls
0
Comment
Question by:McQMom
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
  • 3
12 Comments
 
LVL 6

Accepted Solution

by:
PhilAI earned 500 total points
ID: 33487134
Is this what you meant?
Sub BenchmarksFormatting(rg As Range)
Dim Target As Range
Dim FillColors As Variant, v As Variant
FillColors = Array(38, 40, 36, 35, 37)
With rg.Worksheet
    For Each Target In rg.Cells
        If Target <> "" And IsNumeric(Target) Then
            If Not Intersect(Target, .Range("C4:C41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
                Set Target = Target.Offset(0, 1)
            End If
            If Not Intersect(Target, .Range("D4:D41")) Is Nothing Then
                If Target.Offset(0, -1).Value = 60 And Target.Value < 94 Then
                    Target.Interior.ColorIndex = FillColors(2)
                Else
                    Target.Interior.ColorIndex = Target.Offset(0, -1).Interior.ColorIndex
                End If
            End If
            If Not Intersect(Target, .Range("E4:E41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("F4:F41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("G4:G41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("H4:H41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("I4:I41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("K4:K41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("M4:M41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("N4:N41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("O4:O41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("P4:P41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("Q4:Q41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("S4:S41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("U4:U41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("V4:V41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("W4:W41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("X4:X41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
            If Not Intersect(Target, .Range("Y4:Y41")) Is Nothing Then
                v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
                If Not IsError(v) Then
                    Target.Interior.ColorIndex = FillColors(v - 1)
                End If
            End If
        End If
   Next
End With
End Sub

Open in new window

0
 

Author Comment

by:McQMom
ID: 33487187
Let me plug it in and see. Thanks!
0
 
LVL 10

Expert Comment

by:SANTABABY
ID: 33487282
Try something like the following by coding for the change event for the worksheet in question.
Feel free to limit the range (upto max row for your work area in the sheet), so that the refresh time can reduced, in case of bulk delete/change in colm C or D.
Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cl In Target
        Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset first
        
        If cl.Column = 3 And Cells(cl.Row, 3).Value <> "" Then
            Select Case cl.Value
                Case 0
                    Cells(cl.Row, 4).Interior.ColorIndex = 38
                Case 40
                    Cells(cl.Row, 4).Interior.ColorIndex = 40
                Case 50
                    Cells(cl.Row, 4).Interior.ColorIndex = 36
                Case Is >= 70
                    Cells(cl.Row, 4).Interior.ColorIndex = 37
                Case 60
                  If Cells(cl.Row, 4).Value <> "" Then
                    If Cells(cl.Row, 4).Value < 94 Then
                        Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
                    Else
                        Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
                    End If
                  End If
            End Select
        End If
        If cl.Column = 4 And Cells(cl.Row, 4).Value <> "" And Cells(cl.Row, 3).Value = 60 Then
                Select Case cl.Value
                    Case Is < 94
                        Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
                    Case Else
                        Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
                End Select
        End If
    Next cl
End Sub

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 6

Expert Comment

by:PhilAI
ID: 33487342
Why are you not using Conditional Formatting in Excel? Why the VBA code?
0
 

Author Comment

by:McQMom
ID: 33487726
I need more than 3 formats. There are 6 different colors I need and each column of data has a different set of conditions triggering the colors.
0
 
LVL 10

Expert Comment

by:SANTABABY
ID: 33487999
Just realized that my previous code had some bugs, fixed below:
Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cl In Target
        If cl.Column = 3 Then
            If Not IsNumeric(cl) Or cl = "" Then
                    Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
            Else
              Select Case cl.Value
                Case 0
                    Cells(cl.Row, 4).Interior.ColorIndex = 38
                Case 40
                    Cells(cl.Row, 4).Interior.ColorIndex = 40
                Case 50
                    Cells(cl.Row, 4).Interior.ColorIndex = 36
                Case Is >= 70
                    Cells(cl.Row, 4).Interior.ColorIndex = 37
                Case 60
                  Select Case Cells(cl.Row, 4).Value
                    Case Not IsNumeric(Cells(cl.Row, 4).Value)
                        Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
                    Case Is < 94
                        Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
                    Case Else
                        Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
                    End Select
                Case Else
                    Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
              End Select
            End If
        End If
        If cl.Column = 4 And Cells(cl.Row, 3).Value = 60 Then
            If Not IsNumeric(cl) Or cl = "" Then
                    Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
            Else
                Select Case cl.Value
                    Case Is < 94
                        Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
                    Case Else
                        Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
                End Select
            End If
        End If
    Next cl
End Sub

Open in new window

0
 

Author Comment

by:McQMom
ID: 33488080
tHanks - I'll give it a spin.
0
 

Author Closing Comment

by:McQMom
ID: 33488263
Works perfectly! Thank you!!!!!!
0
 

Author Comment

by:McQMom
ID: 33488269
SantaBaby - thank you for your help. I plugged the code in and it didn't work. PhilAl's seemed to do the trick though. Thank you again!
0
 
LVL 6

Expert Comment

by:PhilAI
ID: 33488272
I cannot see why you cannot do all this without Conditional Formatting, but I suppose the VBA code is easier to manage when there are that many combinations.
0
 
LVL 10

Expert Comment

by:SANTABABY
ID: 33488327
McQMom,
Just curious to know whether my fixed code did the work for you OR you already found another solution.

Thanks,
0
 

Author Comment

by:McQMom
ID: 33488493
I plugged in the fixed code and it didn't work unfortunately!

Phil Al -  boy, I tried the Excel conditional formatting for quite a while before I went reluctantly to VBA. :)
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

738 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question