VBA Coloring Cells Based on Value

[Daniel0sb]

Hey my friends,

I am a beginner at VBA.. I have a data set and i would like to color the Rows based on the color labeled in the "C" column and if the value in the given cell is "1"....For all other data i have labeled it test.


Data Set:
DanielsPicture.JPG

Currently i am able to color the rows based on the color under column "C" but i can't get VBA to recognize the "And r2.Value = 1" portion of my code.

Sub ColorRows()
Dim i As Long, r1 As Range, r2 As Range


For i = 3 To 7
Set r1 = Range("C" & i)
Set r2 = Range("E" & i & ":K" & i)
If r1.Value = "Blue" And r2.Value = 1 Then r2.Interior.ColorIndex = 5
If r1.Value = "Blue" Then r2.Font.ColorIndex = 5
If r1.Value = "Red" Then r2.Interior.ColorIndex = 3
If r1.Value = "Red" Then r2.Font.ColorIndex = 3
If r1.Value = "Orange" Then r2.Interior.ColorIndex = 46
If r1.Value = "Orange" Then r2.Font.ColorIndex = 46
If r1.Value = "Gray" Then r2.Interior.ColorIndex = 48
If r1.Value = "Gray" Then r2.Font.ColorIndex = 48
If r1.Value = "Turquoise" Then r2.Interior.ColorIndex = 8
If r1.Value = "Turquoise" Then r2.Font.ColorIndex = 8
Next i
End Sub

I would like the Cells with a value of 1 to remain colored but the other cells to remain uncolored.
DanielsPicture1.JPG

[gmayor]

You can't have a value based on a range of multiple cells as you anticipate. You will need to loop through the cells in the row e.g. as follows. Are you sure you want the same font colour and the interior colour?

Sub ColorRows()
Dim i As Long, j As Long
Dim r1 As Range, r2 As Range
    With ActiveSheet
        For i = 3 To 7
            For j = 5 To 11
                Set r1 = .Range("C" & i)
                Set r2 = .Cells(i, j)
                If r2.value = 1 Then
                    If r1.value = "Blue" Then r2.Interior.ColorIndex = 5
                    If r1.value = "Blue" Then r2.Font.ColorIndex = 5
                    If r1.value = "Red" Then r2.Interior.ColorIndex = 3
                    If r1.value = "Red" Then r2.Font.ColorIndex = 3
                    If r1.value = "Orange" Then r2.Interior.ColorIndex = 46
                    If r1.value = "Orange" Then r2.Font.ColorIndex = 46
                    If r1.value = "Gray" Then r2.Interior.ColorIndex = 48
                    If r1.value = "Gray" Then r2.Font.ColorIndex = 48
                    If r1.value = "Turquoise" Then r2.Interior.ColorIndex = 8
                    If r1.value = "Turquoise" Then r2.Font.ColorIndex = 8
                End If
            Next j
        Next i
    End With
lbl_Exit:
    Set r1 = Nothing
    Set r2 = Nothing
    Exit Sub
End Sub

[p45cal]

or:

Sub blah()
  For Each cll In Range("C3:C7").Cells 'take each cell in column C in turn
    ci = Application.Index([{5, 3, 46, 48, 8}], Application.Match(cll.Value, [{"Blue", "Red", "Orange", "Gray", "Turquoise"}], 0)) 'determine the ColorIndex
    With cll.Offset(, 2).Resize(, 6) 'the row of 6 cells to the right of the cell in column C
      .Interior.ColorIndex = xlNone 'reset background of the row of 6 cells
      .Font.ColorIndex = -4105 'reset automatic font colour of the row of 6 cells
      If Not IsError(ci) Then 'checks column C has a valid colour name string
        For Each celle In .Cells 'run through each cell in the row of 6
          If celle.Value = 1 Then
            celle.Interior.ColorIndex = ci 'the background
            celle.Font.ColorIndex = ci '(this makes the cell value of 1 unreadable since the font and background are the same colour)
          End If
        Next celle
      End If
    End With
  Next cll
End Sub

[Daniel0sb]

You can't have a value based on a range of multiple cells as you anticipate. You will need to loop through the cells in the row e.g. as follows. Are you sure you want the same font colour and the interior colour?

Sub ColorRows()
Dim i As Long, j As Long
Dim r1 As Range, r2 As Range
    With ActiveSheet
        For i = 3 To 7
            For j = 5 To 11
                Set r1 = .Range("C" & i)
                Set r2 = .Cells(i, j)
                If r2.value = 1 Then
                    If r1.value = "Blue" Then r2.Interior.ColorIndex = 5
                    If r1.value = "Blue" Then r2.Font.ColorIndex = 5
                    If r1.value = "Red" Then r2.Interior.ColorIndex = 3
                    If r1.value = "Red" Then r2.Font.ColorIndex = 3
                    If r1.value = "Orange" Then r2.Interior.ColorIndex = 46
                    If r1.value = "Orange" Then r2.Font.ColorIndex = 46
                    If r1.value = "Gray" Then r2.Interior.ColorIndex = 48
                    If r1.value = "Gray" Then r2.Font.ColorIndex = 48
                    If r1.value = "Turquoise" Then r2.Interior.ColorIndex = 8
                    If r1.value = "Turquoise" Then r2.Font.ColorIndex = 8
                End If
            Next j
        Next i
    End With
lbl_Exit:
    Set r1 = Nothing
    Set r2 = Nothing
    Exit Sub
End Sub

This Works Perfect!!