Double-Click to Change Interoir Color

[Little Penny]

I have a work sheet code that changes the interior color of 32 cell
when double-clicked I would like to add to my existing code so that
the interior color can only in one column at a time for the active row
for example:

IF D12 is double-clicked the interior color is changed to gray. I
would to have it so that if I double-click H12 it changes to gray but
D12 changes back to the default.
Or

IF D14 is double-clicked the interior color is changed to gray. I
would to have it so that if I double-click H14 it changes to gray but
D12 changes back to the default.



D12 Connected to: H12
D14 Connected to: H14
D16 Connected to: H16
D18 Connected to: H18
D20 Connected to: H20
D22 Connected to: H22
D24 Connected to: H24
D26 Connected to: H26
D28 Connected to: H28
D30 Connected to: H30
D32 Connected to: H32
D34 Connected to: H34
D36 Connected to: H36
D38 Connected to: H38
D40 Connected to: H40
D43 Connected to: H43


Is this possible

Here my my worksheet code.

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Const myRange As String =
"D12,D14,D16,D18,D20,D22,D24,D26,D28,D30,D32,D34,D36,D38,D40,D43,H12,H14,H16,H18,H20,H22,H24,H26,H28,H30,H32,H34,H36,H38,H40,H43"
On Error GoTo endit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(myRange)) Is Nothing Then
With Target
If .Interior.ColorIndex = 16 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 16
End If
End With
Cancel = True 'preserve double-click edit for cells not in MyRange
End If
endit:
Application.EnableEvents = True
End Sub



Thanks
Little Penny

 

[Gary''s Student]

A very simple one-line addition to your code:

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Const myRange As String =
"D12,D14,D16,D18,D20,D22,D24,D26,D28,D30,D32,D34,D36,D38,D40,D43,H12,H14,H16,H18,H20,H22,H24,H26,H28,H30,H32,H34,H36,H38,H40,H43"
On Error GoTo endit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(myRange)) Is Nothing Then
With Target
Target.Offset(0, 4).Interior.ColorIndex = xlNone
If .Interior.ColorIndex = 16 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 16
End If
End With
Cancel = True 'preserve double-click edit for cells not in MyRange
End If
endit:
Application.EnableEvents = True
End Sub

Just Offset the target

 

[Little Penny]

Thanks for your reply Garys Student. I tried the code but it does not
give the required results.

Thanks

 

[Don Guillett]

Try it this way
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)

Const myRange As String =
"D12,D14,D16,D18,D20,D22,D24,D26,D28,D30,D32,D34,D36,D38,D40,D43,H12,H14,H16,H18,H20,H22,H24,H26,H28,H30,H32,H34,H36,H38,H40,H43"
On Error GoTo endit
If Target.Column = 4 Then x = 4
If Target.Column = 8 Then x = -4
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(myRange)) Is Nothing Then
With Target

Target.Offset(0, x).Interior.ColorIndex = xlNone
If .Interior.ColorIndex = 16 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 16
End If
End With
Cancel = True 'preserve double-click edit for cells not in MyRange
End If
endit:
Application.EnableEvents = True
End Sub

 

[Bill Renaud]

I used the following technique, which also seems to work well:

1. Add another blank worksheet to your workbook.
2. Name the new worksheet "Color Mask".
3. Select both your data worksheet and the "Color Mask" worksheet.
4. Ctrl-select all of the cells you mentioned ("D12", "H12", "D14", "H14",
etc.).
5. Apply your gray color to those cells.
6. Unselect the 2 worksheets.

Now when you double-click on your worksheet, it will simply check to see if
the "Color Mask" worksheet has a color in the same cell as the Target cell.
If it does, then the routine clears the color on the entire row and copies
the color on the "Color Mask" worksheet to the Target cell. You can make
the colors any color you want, and easily change the target cells by
changing those cells on the "Color Mask" worksheet. No changes to the code
are required.

This routine will clear the color of other cells on the same row, however,
so if you had cell A12 set to Red, it will be cleared once you double-click
on cell D12 or H12. I don't know if you need to retain colors in the other
cells that are not in columns D or H on the same row.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim wsColorMask As Worksheet
Dim rngColorMaskTarget As Range

On Error GoTo ExitSub

Application.EnableEvents = False

Set wsColorMask = ThisWorkbook.Worksheets("Color Mask")

With Target
Set rngColorMaskTarget = wsColorMask.Cells(.Row, .Column)
End With

If rngColorMaskTarget.Interior.ColorIndex <> xlNone _
Then
With Target
'Clear the color of the entire row first.
.EntireRow.Interior.ColorIndex = xlNone

'Now set the color of the Target cell to be the
'same as that on the "Color Mask" worksheet.
.Interior.ColorIndex = rngColorMaskTarget.Interior.ColorIndex
End With
Cancel = True
End If

ExitSub:
Application.EnableEvents = True
End Sub