CODEWITHSUNDEEP
vbaexcel
Myra
Myra

Reputation: 77

Color code the columns

In an excel file, I need to color code a column cell depending upon the number of "Yes" in that Column. If there are no "Yes" : Red color; one "Yes": Yellow color: 2 or more than 2 "Yes": Green color.

Can this be done by some macro ?

Update:

Have made this macro but i am not able to run or debug it as it gives an error of Overflow; The variable N is taking a value of 32676 even after I have assigned it zero value .

Sub testcolor()

Dim i As Integer
Dim j As Integer
Dim N As Integer
Dim z As Integer
Dim val As String
i = 7
j = 5
N = 0
MsgBox (N)
For j = 5 To 15
Do While i < 13
val = ActiveSheet.Cells(i, j).Value
If val = "Yes" Then N = N + 1
Loop
If N = 0 Then
Range(i + 2, j).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 255
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End If
If N = 1 Then
Range(i + 2, j).Select

With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End If
If N > 1 Then
Range(i + 2, j).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 5296274
    .TintAndShade = 0
    .PatternTintAndShade = 0
 End With
 End If

Next j
End Sub

enter image description here enter image description here

Upvotes: 0

Views: 1332

Answers (2)

TAKL
TAKL

Reputation: 339

Another way to solve this is by using Conditional Formatting.

  1. Select the area you wish to format. Looks like it's range E14:K14 in your book.
  2. Click Home > Conditional Formatting > New Rule.
  3. In the New Formatting Rule dialog box, click "Use a formula to determine which cells to format".
  4. Under "Format values where this formula is true", type the following formula:
=AND(E14="Yes",COUNTIF(E:E,"Yes")>=2,ROW()>=7,ROW()<=13)
  1. Next, click the "Format" button.
  2. Now, simply choose the design you wish. Perhaps a colored background is enough.
  3. The GREEN formula is done, but you have to repeat these steps for the yellow and red formulas.
  4. The yellow formula:
=AND(E14="Yes",COUNTIF(E:E,"Yes")<2;COUNTIF(E:E,"Yes")>0,ROW()>=7,ROW()<=13)
  1. And the red formula:
=AND(E14="Yes",COUNTIF(E:E,"Yes")=0,ROW()>=7,ROW()<=13)

Don't forget to apply your format conditions (green/yellow/red background).

Let me break the GREEN formula down for you:

  • AND() - All of the conditions in between these () brackets need to be met.
  • E14="Yes" - The cell has to contain the word "Yes".
  • COUNTIF(E:E,"Yes")>=2 - The column must have 2 or more "Yes".
  • ROW()>=7,ROW()<=13) - The cell has to be somewhere in between rows 7 to 13.

It's quite easy to change these parameters whenever you need to. And perhaps it's easier than jumping into a big chunk of code. It may look quite difficult using Conditional Formatting with multiple conditions, but once you get a hang of it you won't stop using it.

Upvotes: 2

ZAT
ZAT

Reputation: 1347

Try this (set RGB and ColorIndex accordingly, did not get if you want cell text color or fill color): 

Sub ConditionalColorColumn()
    count = Application.WorksheetFunction.CountIf(arg1:=Range("D:D"), arg2:="yes")
    'MsgBox count
    If count = 1 Then
        ActiveSheet.Range("D:D").Font.Color = RGB(255, 255, 0)
        ActiveSheet.Range("D:D").Interior.ColorIndex = 6
    ElseIf count >= 2 Then
        ActiveSheet.Range("D:D").Font.Color = RGB(255, 255, 0)
        ActiveSheet.Range("D:D").Interior.ColorIndex = 6
    Else
        ActiveSheet.Range("D:D").Font.Color = RGB(255, 255, 0)
        ActiveSheet.Range("D:D").Interior.ColorIndex = 6
    End If

End Sub

APPENDED: you can try this for multiple columns

Sub ConditionalColorMultiColumn()
'Dim arr As Variant
'Dim desCell As Range
arr = Array("E", "F", "G", "H", "I","J","K")

For i = 0 To UBound(arr)

Set rngg = Range(arr(i) & 7 & ":" & arr(i) & 12)
'rngg.Select
Set desCell = Cells(14, arr(i))

Count = Application.WorksheetFunction.CountIf(arg1:=rngg, arg2:="yes")
'MsgBox count

If Count = 1 Then
desCell.Interior.ColorIndex = 6
ElseIf Count >= 2 Then
desCell.Interior.ColorIndex = 4
Else: desCell.Interior.ColorIndex = 3
End If

Set desCell = Nothing
Set rngg = Nothing
Next
End Sub

Upvotes: 1

Related Questions