Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / September 2007

Tip: Looking for answers? Try searching our database.

Double-Click to Change Interoir Color

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Little Penny - 23 Sep 2007 15:07 GMT
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 - 23 Sep 2007 15:50 GMT
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
Signature

Gary''s Student - gsnu2007

> 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
[quoted text clipped - 53 lines]
> Thanks
> Little Penny
Little Penny - 23 Sep 2007 16:43 GMT
Thanks for your reply Garys Student. I tried the code but it does not
give the required results.

Thanks

>A very simple one-line addition to your code:
>
[quoted text clipped - 20 lines]
>
>Just Offset the target
Don Guillett - 23 Sep 2007 16:51 GMT
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

Signature

Don Guillett
Microsoft MVP Excel
SalesAid Software
dguillett1@austin.rr.com

>
> I have a work sheet code that changes the interior color of 32 cell
[quoted text clipped - 54 lines]
> Thanks
> Little Penny
Bill Renaud - 23 Sep 2007 18:32 GMT
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

Signature

Regards,
Bill Renaud

 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.