Solved

Excel 2003 VBA conditional color formatting

Posted on 2010-08-20
12
315 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
  • 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
 
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

746 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now