Click Cell to toggle color

[chuckchuckit]

Here is code to color/uncolor a cell you click. It does not toggle unless you click a different cell first, then come back and click original cell again.

How can I get it to toggle color on/off while remaining in same cell?

Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Dim cRED, cGREEN
    cRED = 255
    cGREEN = 5296274
    If Intersect(Target, Range("B2:G10")) Is Nothing Then Exit Sub
 
        'Click and drag in range causes run time error
        'so capture error and exit sub instead
    On Error GoTo errTrap
 
    Application.EnableEvents = False
 
        'Toggle background color on or off
    If ActiveCell.Interior.Pattern = xlSolid Then
            'erase background to no color
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    Else 'no color so make it a backround color
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = cGREEN
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
 
    Application.EnableEvents = True
 
errTrap:     'code goes here if error clicking and dragging
    Exit Sub
End Sub

 

[Sandeep Warrier]

Hi

Try the Worksheet Before Double Click event. Only catch is you'll have to double click a cell for the event to trigger.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim cRED, cGREEN
    cRED = 255
    cGREEN = 5296274
    If Intersect(Target, Range("B2:G10")) Is Nothing Then Exit Sub
 
        'Click and drag in range causes run time error
        'so capture error and exit sub instead
    On Error GoTo errTrap
 
    Application.EnableEvents = False
 
        'Toggle background color on or off
    If ActiveCell.Interior.Pattern = xlSolid Then
            'erase background to no color
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    Else 'no color so make it a backround color
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = cGREEN
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
 
    Application.EnableEvents = True
 
errTrap:     'code goes here if error clicking and dragging
    Exit Sub

End Sub

 

[chuckchuckit]

Thanks sandeep. That works for double click instead of single click, but I still have the same problem.

Which is: If I go to a cell in the range and click that cell (or double click with your version), it will change color. But if I remain in that cell and click it again, it does not remove the color.

To do that I have to go to an other cell and click there, "then" come back and click the original cell for it to turn off the color.

I am trying to remain in the same cell and click color on, click again to turn off.

 

[Comfy]

The BeforeRickClick Event will allow you to click the same cell multiple times but unfortunately you will get the menu appearing.

 

[MisterBate5]

Works OK for me. You have to double-click each time, even if in the same cell. Double-click to change colour.

 

[chuckchuckit]

There may not be a way to do it without a modification to some other parameter. As it appears this function will only run once per "selection"?

 

[dave3009]

You can use the right click event without the menu popup, it does mean that the right click menu will never be available in those cells.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim cRED, cGREEN
    cRED = 255
    cGREEN = 5296274
    If Intersect(Target, Range("B2:G10")) Is Nothing Then Exit Sub
 
        'Click and drag in range causes run time error
        'so capture error and exit sub instead
 
    Application.EnableEvents = False
 
        'Toggle background color on or off
    If ActiveCell.Interior.Pattern = xlSolid Then
            'erase background to no color
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    Else 'no color so make it a backround color
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = cGREEN
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
    Cancel = True
    Application.EnableEvents = True
    
End Sub

 

[chuckchuckit]

The right click version works great on my computer. The events also seem to also be working on my computer. I would just as soon "not" have them active if I were to use the right click.

Is there a way to make the right click events not active in this range?

 

[chuckchuckit]

It looks like you turned off the error capture. Is it problematic the way it is coded?

 

[GTO]

Works OK for me. You have to double-click each time, even if in the same cell. Double-click to change colour.

There may not be a way to do it without a modification to some other parameter. As it appears this function will only run once per "selection"?

A guess, but are you meaning that you have to exit the cell and return because of entering edit mode?

Maybe...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    If Not Application.Intersect(Target, Range("B2:G10")) Is Nothing _
    And Target.Count = 1 Then
        
        Cancel = True
        
        Select Case True
        Case Target.Interior.ColorIndex = xlNone: Target.Interior.Color = 52377
        Case Target.Interior.Color = 52377: Target.Interior.ColorIndex = xlNone
        End Select
    End If
End Sub