Code to change row (cell range) color with or without button

[asdsparky]

I'm working on a spreadsheet that uses colors for quality of items (Good=green, Fair=yellow, Poor=red or N/A=gray). Each row will need to change to the color of the rating for that row and needs to stay within columns A-J. Also, if I select a different rating for the row, the color needs to change for that rating. I would prefer to accomplish this by simply selecting the appropriate box for the row rather than adding a radial button in each box (very time consuming). I have attempted with conditional formatting and with vba codes and with grouping radial buttons but I can't seem to get it right. Here is an example of my worksheet:https://flic.kr/p/ZBjhvq. Any help would be greatly appreciated.

 

[asdsparky]

*Update: I've managed to get the code to where I can put a check in each of the rating cells, but it cancels out the color fill and it allows more than one cell to be checked at a time. See current code below. Obviously, it still needs some tweaking.

[/URL]******** async src="//embedr.flickr.com/assets/client-code.js" charset="utf-8">*********>[/IMG]

 

[My Aswer Is This]

When you post your code it's best to post it like this:
Not as a image:

If Target.Column = 9 Then Range(Cells(Target.Row, "A"), Cells(Target.Row, "J")).Interior.ColorIndex = 3
If Target.Column = 10 Then Range(Cells(Target.Row, "A"), Cells(Target.Row, "J")).Interior.ColorIndex = 15

 

[Rick Rothstein]

Thank you both for the response. Both codes give me the same result. You guys are awesome. I do have a couple of other thoughts on this one: 1. can I add an X the cell with the cell selection at the same time as changing the color? 2. Can I use an RGB code (##,##,##) for custom colors rather than color index? 3. Can I add to the 'Reset_Click' (Module 2) code to clear the fill color when I reset the worksheet?

Here is my code modified to do all of the changes you have requested above (you can modify the colors using the assignments at the beginning of the code)...

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Green As Long, Yellow As Long, Red As Long, Gray As Long, Black As Long, White As Long
  Green = RGB(0, 255, 0)
  Yellow = RGB(255, 255, 0)
  Red = RGB(255, 0, 0)
  Gray = RGB(128, 128, 128)
  Black = RGB(0, 0, 0)
  White = RGB(255, 255, 255)
  If Target.CountLarge = 1 Then
    If Target.Row > 13 And Target.Column > 6 And Target.Column < 11 And Target.Count = 1 Then
      With Intersect(Target.EntireRow, Columns("A:J"))
        Intersect(.Cells, Columns("G:J")).ClearContents
        Target.Value = "X"
        Target.HorizontalAlignment = xlCenter
        .Cells.Interior.Color = Choose(Target.Column - 6, Green, Yellow, Red, Gray)
        .Cells.Font.Color = Choose(Target.Column - 6, Black, Black, White, White)
        .Cells.Font.Bold = Target.Column > 8
      End With
    End If
  End If
  '
  '  Put any other Worksheet_SelectionChange code here
  '
End Sub[/td]
[/tr]
[/table]

 

[asdsparky]

I tweaked it just a bit, but works like a charm. Thanks a bunch for your help.

Private Sub Worksheet_SelectionChange(ByVal Target As range)
  Dim Green As Long, Yellow As Long, Red As Long, Gray As Long, Black As Long, White As Long
  Green = RGB(0, 255, 0)
  Yellow = RGB(255, 255, 0)
  Red = RGB(255, 0, 0)
  Gray = RGB(128, 128, 128)
  Black = RGB(0, 0, 0)
  If Target.CountLarge = 1 Then
    If Target.Row > 13 And Target.Column > 6 And Target.Column < 11 And Target.Count = 1 Then
        With Intersect(Target.EntireRow, Columns("A:J"))
        Intersect(.Cells, Columns("G:J")).ClearContents
        Target.Value = Chr(252)
        Target.Font.Name = "Wingdings"
        Target.Font.Size = 12
        Target.HorizontalAlignment = xlCenter
         .Cells.Interior.Color = Choose(Target.Column - 6, Green, Yellow, Red, Gray)
         .Cells.Font.Color = Choose(Target.Column - 6, Black, Black, Black, Black)
        End With
    End If
  End If
     
 With ActiveCell
            If Intersect(range("F4"), .Cells) Is Nothing Then Exit Sub
           .Value = Date
 End With
    
End Sub

 

[My Aswer Is This]

Glad to see you have it working for you. I have never used "Choose""

OK Rick:
Why do we need this line of code and what does it do?
"If Target.CountLarge = 1 Then"

 

[Rick Rothstein]

OK Rick:
Why do we need this line of code and what does it do?
"If Target.CountLarge = 1 Then"

If your question is why use CountLarge instead of just Count, it is because selecting all the cells on the worksheet contain more cells than Count can handle, so you need to use CountLarge which can handle that many cells. The code itself is making sure only one cell is selected before seeing if that cell is in one of the four columns of interest.

 

[asdsparky]

Hey guys, I have another string I'm trying to add to this workbook to auto-hide specific rows based on the dropdown selection of Cell F7. Once I can get it to work, I will be adding more building areas and specific rows to the string. I also need the rows to return to un-hidden when the form is reset (thus the {If range("F7") = "" Then}). Here is the entire code for the sheet. The string I am trying to implement for the auto-hide is at the end, beginning with "IF Target.Address"...I'm not getting any errors, I just get no activity when I select "Dorm" or "Food Service". Any ideas?

Private Sub Worksheet_SelectionChange(ByVal Target As range)
  Dim Green As Long, Yellow As Long, Red As Long, Gray As Long, Black As Long, Clear As Long
  Green = RGB(201, 221, 176)
  Yellow = RGB(255, 237, 153)
  Red = RGB(253, 173, 150)
  Gray = RGB(118, 122, 121)
  Black = RGB(0, 0, 0)
  Clear = xlNone
  If Target.CountLarge = 1 Then
    If Target.Row > 13 And Target.Column > 6 And Target.Column < 12 And Target.Count = 1 Then
        With Intersect(Target.EntireRow, Columns("A:K"))
        Intersect(.Cells, Columns("G:K")).ClearContents
        Target.Value = Chr(252)
        Target.Font.Name = "Wingdings"
        Target.Font.Size = 10
        Target.HorizontalAlignment = xlCenter
         .Cells.Interior.Color = Choose(Target.Column - 6, Green, Yellow, Red, Gray, Clear)
         .Cells.Font.Color = Choose(Target.Column - 6, Black, Black, Black, Black, Black)
        End With
    End If
  End If
     
 With ActiveCell
            If Intersect(range("F4"), .Cells) Is Nothing Then Exit Sub
           .Value = Date
 End With
 
 If Target.Address = "$F$7" Then
   If range("F7") = "" Then
     Rows("13:400").EntireRow.Hidden = False
   ElseIf range("F7") = "Dorm" Then
     Rows("13:24,68:175,221:400").EntireRow.Hidden = False
     Rows("25:67,176:220").EntireRow.Hidden = True
   ElseIf range("F7") = "Food Service" Then
     Rows("13:24,68:175,186:400").EntireRow.Hidden = False
     Rows("25:67,176:185").EntireRow.Hidden = True
   End If
 End If
    
End Sub

 

[asdsparky]

Update (no progress)...
I have scoured the internet and tried applying these codes (as well as two or three others I didn't copy) in addition to the one above, and have hit a wall. By all counts, one of the codes should at least do something, but no... nothing changes in the sheet. I still need to add about 10 other building names to the code but I need to get a working code first. Any ideas? (Disclaimer: each of these was tried individually and without the '. )

'Private Sub Worksheet_Change(ByVal Target As range)
' 
'    If Not Intersect(Target, range("F7")) Is Nothing Then
'        With range("F7")
'            If .Value = "" Then
'                Me.Rows.Hidden = False
'                Exit Sub
'            End If
'            range("25:67,176:200").EntireRow.Hidden = .Value = "Dorm"
'            range("25:67,176:185").EntireRow.Hidden = .Value = "Food Service"
'        End With
'    End If
' 
'End Sub

'-------------------------------------------------------------------------------------------

'Private Sub Worksheet_Change(ByVal Target As range)
'
'    If Not Intersect(Target, range("F7")) Is Nothing Then
'        With range("F7")
'            range("25:67,176:200").EntireRow.Hidden = .Value = "Dorm"
'            range("25:67,176:185").EntireRow.Hidden = .Value = "Food Service"
'        End With
'    End If
'
'End Sub

'----------------------------------------------------

'Private Sub Worksheet_Change(ByVal Target As range)
'
'   If Target.Address = "$F$7" Then
'     If Target.Value = "" Then
'       Rows("13:400").EntireRow.Hidden = False
'     If Target.Value = "Dorm" Then
'       Rows("13:24,68:175,221:400").EntireRow.Hidden = False
'       Rows("25:67,176:200").EntireRow.Hidden = True
'     ElseIf Target.Value = "Food Service" Then
'       Rows("13:24,68:175,186:400").EntireRow.Hidden = False
'       Rows("25:67,176:185").EntireRow.Hidden = True
'     End If
'   End If
'End Sub

'--------------------------------------------------------------------------------------

'Private Sub Worksheet_Change(ByVal Target As Range)

'If Range("F7").Value = "Dorm" Then
'Rows("113:24, 68:175, 221:400").Hidden = False
'Else
'Rows("25:67,176:200").Hidden = True
'End If
 
'If Range("F7").Value = "Food Service" Then
'Rows("13:24, 68:175, 221:400").Hidden = False
'Else
'Rows("25:67, 176:185").Hidden = True
'End If
 
'End Sub

 

[asdsparky]

I figured out the issue. Pretty much any of these should work as long as the target value, "TEXT" does not include a 'space' after the text in the validation list. .

Thank you Rick Rothstein and My Answer Is This for working with me on this.

 

[MARK858]

Try one of the below (anywhere you are testing the value of the cell) then it shouldn't make any difference if you have leading or trailing spaces...

If Not Intersect(Target, [COLOR="#FF0000"]WorksheetFunction.Trim[/COLOR](Range("F7"))) Is Nothing Then

or

If Not Intersect(Target, [COLOR="#FF0000"]Application.Trim[/COLOR](Range("F7"))) Is Nothing Then