View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Don Guillett Don Guillett is offline
external usenet poster
 
Posts: 10,124
Default Double-Click to Change Interoir Color

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,D 36,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

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Little Penny" wrote in message
...

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,D 36,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