Color Cell based off of a Simple Range.

[pawcoyote]

Hi,

Working on a VBA code for Filling in colors in cells based off of an Range Cell Value. It doesn't seem to run automatically, where once I change a value I have to click somewhere on the spreadsheet. Also, If the cell doesn't have any of the below Text we want the sell to go to the color White. I am missing something here...


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim MY_Range As Range


Set MY_Range = Worksheets("CAD").Range("B2:I20")


For Each Cell In MY_Range


If Cell.Value Like "Red" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell.Value Like "Yellow" Then
Cell.Interior.ColorIndex = 6
ElseIf Cell.Value Like "Green" Then
Cell.Interior.ColorIndex = 43
ElseIf Cell.Value Like "OUT OF COMPLIANCE" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell.Value Like "REVISING" Then
Cell.Interior.ColorIndex = 6
ElseIf Cell.Value Like "IN COMPLIANCE" Then
Cell.Interior.ColorIndex = 43
ElseIf Cell.Value Like "IN REVIEW" Then
Cell.Interior.ColorIndex = 45
ElseIf Cell.Value Like "Grade 1" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell.Value Like "Grade 2" Then
Cell.Interior.ColorIndex = 45
ElseIf Cell.Value Like "Grade 3" Then
Cell.Interior.ColorIndex = 6
ElseIf Cell.Value Like "Pass" Then
Cell.Interior.ColorIndex = 43

'Else
'Cell.Interior.ColorIndex = 2 - This changes any cell within the Range B2:I20 to White and we don't want that. We want only the cells that are referenced above to be set to White


End If

Next


End Sub

[Paul_Hossler]

Just guessing here

1. I think you want Worksheet_Change, and not Worksheet_SelectionChange

2. Since this is on the code page for the worksheet (I assume 'CAD') you don't need to specify it

3. 'With' and 'Select Case' will simplify your code

4. This will fire for EVERY cell change, so you might want to test Target and exit if there's no need to update for that changed cell

5. You could look at using Conditional Formatting and then you wouldn't need any VBA



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range) ' <<<<<<<<<<<<<<<<<
Dim rCell As Range

For Each rCell In Range("B2:I20").Cells
With rCell
Select Case .Value
Case "Red"
.Interior.ColorIndex = 3
Case "Yellow"
.Interior.ColorIndex = 6
Case "Green"
.Interior.ColorIndex = 43
Case "OUT OF COMPLIANCE"
.Interior.ColorIndex = 3
Case "REVISING"
.Interior.ColorIndex = 6
Case "IN COMPLIANCE"
.Interior.ColorIndex = 43
Case "IN REVIEW"
.Interior.ColorIndex = 45
Case "Grade 1"
.Interior.ColorIndex = 3
Case "Grade 2"
.Interior.ColorIndex = 45
Case "Grade 3"
.Interior.ColorIndex = 6
Case "Pass"
.Interior.ColorIndex = 43
Case Else
'Else
'Cell.Interior.ColorIndex = 2 - This changes any cell within the Range B2:I20 to White and we don't want that. We want only the cells that are referenced above to be set to White
End Select
End With
Next


End Sub

[pawcoyote]

Thank you very much. very helpful. A follow up question if you do not mind.

The Cells that are filled in keep a color if they are blank. Would like to have them set to White if they are blank. The below changes every cell to white if they do not have any of the Cases. Have other cells with other colors in them and do not wish to have them changed. What is missing? Should there be a "ISBLANK" statement in there?


Case Else
'Else
'Cell.Interior.ColorIndex = 2 - This changes any cell within the Range B2:I20 to White and we don't want that. We want only the cells that are referenced above to be set to White



Just guessing here

1. I think you want Worksheet_Change, and not Worksheet_SelectionChange

2. Since this is on the code page for the worksheet (I assume 'CAD') you don't need to specify it

3. 'With' and 'Select Case' will simplify your code

4. This will fire for EVERY cell change, so you might want to test Target and exit if there's no need to update for that changed cell

5. You could look at using Conditional Formatting and then you wouldn't need any VBA



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range) ' <<<<<<<<<<<<<<<<<
Dim rCell As Range

For Each rCell In Range("B2:I20").Cells
With rCell
Select Case .Value
Case "Red"
.Interior.ColorIndex = 3
Case "Yellow"
.Interior.ColorIndex = 6
Case "Green"
.Interior.ColorIndex = 43
Case "OUT OF COMPLIANCE"
.Interior.ColorIndex = 3
Case "REVISING"
.Interior.ColorIndex = 6
Case "IN COMPLIANCE"
.Interior.ColorIndex = 43
Case "IN REVIEW"
.Interior.ColorIndex = 45
Case "Grade 1"
.Interior.ColorIndex = 3
Case "Grade 2"
.Interior.ColorIndex = 45
Case "Grade 3"
.Interior.ColorIndex = 6
Case "Pass"
.Interior.ColorIndex = 43
Case Else
'Else
'Cell.Interior.ColorIndex = 2 - This changes any cell within the Range B2:I20 to White and we don't want that. We want only the cells that are referenced above to be set to White
End Select
End With
Next


End Sub

[Paul_Hossler]

The Cells that are filled in keep a color if they are blank.

Would like to have them set to White if they are blank.



Try this

It removed all color from the range and them applies color based on values

(BTW, it's not really necessary to quote the entire message when replying, only the pertinent parts if any)



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range

Range("B2:I20").Interior.ColorIndex = xlColorIndexNone

For Each rCell In Range("B2:I20").Cells
With rCell
Select Case .Value
Case "Red"
.Interior.ColorIndex = 3
Case "Yellow"
.Interior.ColorIndex = 6
Case "Green"
.Interior.ColorIndex = 43
Case "OUT OF COMPLIANCE"
.Interior.ColorIndex = 3
Case "REVISING"
.Interior.ColorIndex = 6
Case "IN COMPLIANCE"
.Interior.ColorIndex = 43
Case "IN REVIEW"
.Interior.ColorIndex = 45
Case "Grade 1"
.Interior.ColorIndex = 3
Case "Grade 2"
.Interior.ColorIndex = 45
Case "Grade 3"
.Interior.ColorIndex = 6
Case "Pass"
.Interior.ColorIndex = 43
End Select
End With
Next
End Sub



Here's an alternative, little more efficient and cleaner.

1. Checks to see if the cells that were changed are in B2:I20 and exits if not

2. Only checks the cells that were actually changed, not all of them in B2:I20 (might be single cell typically I'm thinking)

3. Tests UPPER CASE so that 'pass' and 'Pass' and 'PASS' are get color

4. Uses some built in .Color (not .ColorIndex) constants

5. Consolidates the conditions in the 'Case' statement




Option Explicit




Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range, rChanged As Range

Set rChanged = Intersect(Range("B2:I20"), Target)

If rChanged Is Nothing Then Exit Sub

For Each rCell In rChanged.Cells
With rCell
If Len(.Value) = 0 Then
.Interior.ColorIndex = xlColorIndexNone

Else
Select Case UCase(.Value)
Case "RED", "GRADE 1", "OUT OF COMPLIANCE"
.Interior.Color = vbRed

Case "YELLOW", "REVISING", "GRADE 3"
.Interior.Color = vbYellow

Case "GREEN", "PASS", "IN COMPLIANCE"
.Interior.Color = vbGreen

Case "IN REVIEW", "GRADE 2"
.Interior.ColorIndex = 45
End Select
End If
End With
Next
End Sub

[pawcoyote]

Hi Paul,

Thank you for the guidance. Have attached a quick sample of the area that I am working on. There is other Data Validations that I use for selection of the Site and the other cells on the sheet populate info based on that Site from other worksheets I have. I removed all the other Validations and sheets so you can see what I am working with. i.e. the Other cells that have colors already in them that I do not wish changed. Only the Cells that have the referenced list of names within those cells. Cell in scope right now. B3-B4, D3-D4, H&I-10, H&I-16 What I want to do is other than color coding the cells based on the existing code but if there is no data in these cells the cell is set to "White". If you want the other codes I am using added please let me know.

[Paul_Hossler]

This might be simpler and more maintainable



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Call DoFill(Target, Range("B3:B4"))
Call DoFill(Target, Range("D3:D4"))
Call DoFill(Target, Range("H10:I10"))
Call DoFill(Target, Range("H16:I16"))
End Sub




Private Sub DoFill(T As Range, R As Range)
Dim rCell As Range

If Intersect(T, R) Is Nothing Then Exit Sub

For Each rCell In Intersect(T, R).Cells
With rCell
Select Case UCase(.Value)
Case "RED", "GRADE 1", "OUT OF COMPLIANCE"
.Interior.Color = vbRed

Case "YELLOW", "REVISING", "GRADE 3"
.Interior.Color = vbYellow

Case "GREEN", "PASS", "IN COMPLIANCE"
.Interior.Color = vbGreen

Case "IN REVIEW", "GRADE 2"
.Interior.ColorIndex = 45

Case Else
.Interior.ColorIndex = xlColorIndexNone
End Select
End With
Next
End Sub

[pawcoyote]

Hi, it doesn't seem to work once I add in my XLOOKUPs into their respective cells. So I added them and when I select the Site it changes my values with the XLOOKUP but it doesn't seem to like the color coding or the fill of White if Blank and All Sites selected.

Attached Sample.

[Paul_Hossler]

I assumed from your first post that you were entering directly into the cells

You need Worksheet_Calculate to be triggered (Application.Calculation NOT manual !!!)

If you're not entering the status into the cells directly, you could probably remove the Worksheet_Change and related code



Option Explicit


Private Sub Worksheet_Calculate()
Call FillAfterCalculation(Range("B3:B4"))
Call FillAfterCalculation(Range("D3:D4"))
Call FillAfterCalculation(Range("H10:I10"))
Call FillAfterCalculation(Range("H16:I16"))
End Sub




Private Sub FillAfterCalculation(R As Range)
Dim rCell As Range

For Each rCell In R.Cells
With rCell
Select Case UCase(.Value)
Case "RED", "GRADE 1", "OUT OF COMPLIANCE"
.Interior.Color = vbRed

Case "YELLOW", "REVISING", "GRADE 3"
.Interior.Color = vbYellow

Case "GREEN", "PASS", "IN COMPLIANCE"
.Interior.Color = vbGreen

Case "IN REVIEW", "GRADE 2"
.Interior.ColorIndex = 45

Case Else
.Interior.ColorIndex = xlColorIndexNone
End Select
End With
Next
End Sub

[pawcoyote]

Thank you so much Paul, I am sorry still learning nuances of how to post help info. I didn't know that having a trigger would not cause the code to work properly. Thank you for that guidance and also thank you for helping me with this. I am working on another thing as well but will post in another thread since it doesn't have to do with this one.

Again thank you so much for all your help!