Coloring cells via doubleclick

Question

I noticed that the rules says to not ask for clarification in someone else's question, so hopefully this is the correct way to do it. I initially found enough of an answer to get me where I am at on Change color of cell with mouse click in Excel. Thank you user3159079 and tigeravatar.

I have this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)    
    Cancel = True
    Worksheet_SelectionChange Target   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'If the target cell is clear
     If Target.Interior.ColorIndex = xlNone Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 4

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 4 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 6

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 6 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 3

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 3 Then

        'Then clear the background color
        Target.Interior.ColorIndex = xlNone

    End If
End Sub

but I have 3 problems.

1) I would like to specify a few ranges that this works without affecting other cells (i.e. I would like it to work on...

$F$4:$F$6
$D$10:$I$12
$F$17:$I$34
$N$5:$O$6
$N$10:$O$11
$O$15:$P$18
$O$24:$P$24
$O$29:$P$29
$O$34:$P$34
$U$6:$X$7
$U$10:$X$14
$AA$6:$AG$8
$F$38:$F$43
$N$38:$N$44
$E$48:$E$51
$Q$48:$R$51
$X$23:$AG$35

... and nowhere else.

2) I would like this to only work on double click instead of the cell changing on the first single click

3) This works until I save, close and reopen the spreadsheet. After I reopen the worksheet, the color on click functionality goes away.

I am not very savvy on any of this, but I am able to search fairly well, which is how I have gotten this far, but I cannot figure it out any further so any help would be greatly appreciated.

hstay · Accepted Answer · 2014-03-04T07:49:23.860

I modified your code below to fullfill requirements 1) and 2).

For requirement 3): Save your spreadsheet in .xlsm format and once you open it again, allow macros to run.

Let me know how it goes:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim MyRange As Range

    '(1) Desired Range where it works:
    Set MyRange = Range("$F$4:$F$6,$D$10:$I$12,$F$17:$I$34,$N$5:$O$6," & _
                        "$N$10:$O$11,$O$15:$P$18,$O$24:$P$24,$O$29:$P$29," & _
                        "$O$34:$P$34,$U$6:$X$7,$U$10:$X$14,$AA$6:$AG$8," & _
                        "$F$38:$F$43,$N$38:$N$44,$E$48:$E$51,$Q$48:$R$51," & _
                        "$X$23:$AG$35")
    Cancel = True

    '(1) Check if double clicked cell is one where the code should work:
    If Not Intersect(Target, MyRange) Is Nothing Then
        Custom_ColourChange Target
    End If
End Sub

'(2) Changed from default Worksheet_Selection event to Custom Sub:
Private Sub Custom_ColourChange(ByVal Target As Range)
  'If the target cell is clear
     If Target.Interior.ColorIndex = xlNone Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 4

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 4 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 6

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 6 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 3

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 3 Then

        'Then clear the background color
        Target.Interior.ColorIndex = xlNone

    End If
End Sub

EDIT:

Edited following @BK201 and @simoco comments

Instead of looping over `MyRange`, wouldn't checking `If Not Intersect(...) Is Nothing` prove to be better? — WGS, Mar 03 '14 at 16:56
Definitely! I just couldn't remember the proper way to do it. Thanks. — hstay, Mar 03 '14 at 17:12
@hstay, also instead `Application.Union(...)` you could simply use: `Range("F4:F6,D10:I12,F17:I34,...")`. It would be slightly shorter — Dmitry Pavliv, Mar 03 '14 at 18:42
Thanks for the help. The code you changed worked perfectly. So now what do I do, click the checkmark next to the answer? — Shane Huskey, Mar 04 '14 at 14:42

Coloring cells via doubleclick

1 Answers1