PDA

View Full Version : VBA Coloring Cells Based on Value



Daniel0sb
02-24-2018, 08:35 PM
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:
21694




























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.
21695

gmayor
02-25-2018, 06:56 AM
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
02-25-2018, 12:28 PM
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
02-25-2018, 06:22 PM
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!!