• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 303
  • Last Modified:

Allow only one cell PER ROW to change color when dbl-clicked

Hi, Experts!
I use the code below to toggle a cell's background color and font color when double-clicked.
However, I need to allow only one cell per row to have it's background and font color changed.
Is there any way to check for this?
The behavior would be:
Cell I6 is double-clicked:  color changes to blue/yellow.
Cell J6 is double-clicked:  color changes to blue/yellow, and cell I6 returns to no-color/black.
Cell I7 is double-clicked:  color changes to blue/yellow.
Cell I8 is double-clicked:  color changes to blue/yellow.
Cell K8 is double-clicked:  color changes to blue/yellow, and cell I8 returns to no-color/black.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim rngCheck As Range
   Dim lngColourIndex As Long
   lngColourIndex = 5
   Set rngCheck = Range("I6:M35")
   If Intersect(Target, rngCheck) Is Nothing Then Exit Sub
   If Target.Interior.ColorIndex = lngColourIndex Then
      Target.Interior.ColorIndex = xlColorIndexNone
      Target.Font.Color = vbBlack
   Else
      Target.Interior.ColorIndex = lngColourIndex
      Target.Font.Color = vbYellow
   End If
   Cancel = True
End Sub

Open in new window

0
OGSan
Asked:
OGSan
  • 4
  • 3
1 Solution
 
TommySzalapskiCommented:
Use this instead:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim rngCheck As Range
   Dim lngColourIndex As Long
   lngColourIndex = 5
   Set rngCheck = Range("I6:M35")
   If Intersect(Target, rngCheck) Is Nothing Then Exit Sub
   If Target.Interior.ColorIndex = lngColourIndex Then
      Target.Interior.ColorIndex = xlColorIndexNone
      Target.Font.Color = vbBlack
   Else
      Target.EntireRow.Interior.ColorIndex = xlColorIndexNone
      Target.EntireRow.Font.Color = vbBlack
      Target.Interior.ColorIndex = lngColourIndex
      Target.Font.Color = vbYellow
   End If
   Cancel = True
End Sub

Open in new window

0
 
TommySzalapskiCommented:
All I did was add a line to change the entire row to no color/black before setting the blue/yellow.
0
 
TommySzalapskiCommented:
Or if you only want it to affect columns I through M use this instead.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim rngCheck As Range
   Dim lngColourIndex As Long
   lngColourIndex = 5
   Set rngCheck = Range("I6:M35")
   If Intersect(Target, rngCheck) Is Nothing Then Exit Sub
   If Target.Interior.ColorIndex = lngColourIndex Then
      Target.Interior.ColorIndex = xlColorIndexNone
      Target.Font.Color = vbBlack
   Else
      Range(Range("I" & Target.Row), Range("M" & Target.Row)).Interior.ColorIndex = xlColorIndexNone
      Range(Range("I" & Target.Row), Range("M" & Target.Row)).Font.Color = vbBlack
      Target.Interior.ColorIndex = lngColourIndex
      Target.Font.Color = vbYellow
   End If
   Cancel = True
End Sub

Open in new window

0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
OGSanAuthor Commented:
Thanks, Tommy.  Is it possible to limit it to just the range defined?  The problem is that there is some cell formatting in the other columns.  THANKS!  Almost there...!
0
 
OGSanAuthor Commented:
Outstanding - you actually posted this solution before I was able to reply to your initial solution.  FANTASTIC!  I really appreciate the quick reply, Tommy.  This really, really helps me out of a jam.  Thank you SO very much.
Jeff (aka OGSan)
0
 
TommySzalapskiCommented:
Yeah, I realized you might want it that way when I was testing it.
0
 
OGSanAuthor Commented:
Yes - you read my mind quite literally!  Thanks again.
0

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now