Can you change a cell color just by clicking it?

[donutboy]

I would like to turn a group of cells red or green just by using mouse clicks. Click one time and it turns red, click it again it turns green. Is that possible?


If that is not possible I would like to turn them colors by entering "y" for yes = green and "n" for no = red.



Thanks you guys/gals

 

[VoG]

Try

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Interior.ColorIndex
    Case xlNone, 4: Target.Interior.ColorIndex = 3
    Case 3: Target.Interior.ColorIndex = 45
    Case 45: Target.Interior.ColorIndex = 4
    Case Else: Target.Interior.ColorIndex = xlNone
End Select
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub

 

[Fasteddie]

This works a treat! Thanks very much

 

[charms55]

This works great for what I need to do. However, I want to exclude some cells. Simply locking kills the subroutine and throws an error. Others will be using the form to enter their availability by coloring times they are available green. But they can't click on the headings or times in certain columns.

 

[jerryvaina]

This works awesome for me, but I am looking for a 4th color.
Ex:
Red
Orange
Blue
Green

When I return to my page after saving, it doesn't seem to work. Am I doing something wrong?

Thanks

 

[nachiketsakinal]

Can any body help me to get this function work: Code required for:
When I click on any cell then another required cell should be highlighted during that clicked cell.

 

[GarrettH]

Can I dedicate this function to a single column?

 

[Tom.Jones]

Try this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rng As Range
Cancel = True
Set rng = ActiveSheet.Range("A2:A300") '<--- change range
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
Select Case Target.Interior.ColorIndex
Case xlNone, 4: Target.Interior.ColorIndex = 3
Case 3: Target.Interior.ColorIndex = 45
Case 45: Target.Interior.ColorIndex = 5
Case 5: Target.Interior.ColorIndex = 4
Case Else: Target.Interior.ColorIndex = xlNone
End Select
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub

 

[GarrettH]

Try this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rng As Range
Cancel = True
Set rng = ActiveSheet.Range("A2:A300") '<--- change range
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
Select Case Target.Interior.ColorIndex
Case xlNone, 4: Target.Interior.ColorIndex = 3
Case 3: Target.Interior.ColorIndex = 45
Case 45: Target.Interior.ColorIndex = 5
Case 5: Target.Interior.ColorIndex = 4
Case Else: Target.Interior.ColorIndex = xlNone
End Select
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub

Wow! I could not have figured this out on my own if I tried. THANK YOU!

 

[Tom.Jones]

Glad to help you.

 

[Peter_SSs]

A couple of relatively minor comments about this snippet of code.

1. I would move the Cancel = True line as shown. If not, you are denying a user who has the setting "Allow editing directly in cells" the opportunity to use that feature for the entire worksheet. Moving as shown would still allow such editing everywhere except 'rng'
   
   
2. The underlined line could be removed. If there are no merged cells in the worksheet then it is impossible to double-click more than 1 cell anyway. If you are dealing with merged cells then you probably do want the double-click event to apply to a double-clicked merged area.