Double click for changing cell color

mholton63

New Member
Joined
Nov 16, 2018
Messages
9
I have this VBA (see below) to change the cell color on a double click. I need to make this so it will change a row of cells with the double click. Any ideas?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Interior.ColorIndex
Case xlNone, 3: Target.Interior.ColorIndex = 43
Case 43: Target.Interior.ColorIndex = 6
Case 6: Target.Interior.ColorIndex = 3
Case Else: Target.Interior.ColorIndex = xlNone
End Select
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub


Thanks!
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Interior.ColorIndex
Case xlNone, 3: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 43
Case 43: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 6
Case 6: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 3
Case Else: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = xlNone
End Select
End Sub
 
Upvote 0
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Interior.ColorIndex
Case xlNone, 3: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 43
Case 43: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 6
Case 6: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 3
Case Else: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = xlNone
End Select
End Sub

Thanks Joe
 
Upvote 0
I have this VBA (see below) to change the cell color on a double click. I need to make this so it will change a row of cells with the double click. Any ideas?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Interior.ColorIndex
Case xlNone, 3: Target.Interior.ColorIndex = 43
Case 43: Target.Interior.ColorIndex = 6
Case 6: Target.Interior.ColorIndex = 3
Case Else: Target.Interior.ColorIndex = xlNone
End Select
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub

Hey
JoeMo,
hoping you may be able to help me.
I too have used the above code, and all works well until I protect the work sheet.
When I double click a cell, a Run Time Error '1004' pops up saying 'Application-defined or Object-defined error'
Then there is End, Debug or Help options.
Why does it work unprotected, but doesn't protected?
The cells in question are not locked or hidden when protected.
Hope to hear,
Thanks,
Allofus
 
Upvote 0
Try modifying the two macros to allow VBA to make changes to the protected sheet. Here's an untested modification for the double click event. Use an analogous mod to the right click event. Put your password between the quotes (shown below in bold red font).
Rich (BB code):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Me.Protect Password:="Your Password between the quote marks", userinterfaceonly:=True
Cancel = True
If Intersect(Rows(Target.Row), Me.UsedRange) Is Nothing Then Exit Sub
Select Case Target.Interior.ColorIndex
Case xlNone, 3: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 43
Case 43: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 6
Case 6: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 3
Case Else: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = xlNone
End Select
End Sub
 
Last edited:
Upvote 0
Thanks for the quick reply Joe!
I'm soooo green. is that the password I use to protect the sheet?
 
Upvote 0
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Interior.ColorIndex
Case xlNone, 3: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 43
Case 43: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 6
Case 6: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = 3
Case Else: Intersect(Rows(Target.Row), Me.UsedRange).Interior.ColorIndex = xlNone
End Select
End Sub
The above event code could be written this way and it would also work...
Code:
[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Cancel = True
  Target.EntireRow.Interior.ColorIndex = Val(Split("/43/6/3/-4142/43/", "/" & Target.Interior.ColorIndex & "/")(1))
End Sub[/td]
[/tr]
[/table]
Note that the slash delimited text string (first argument for the Split function) has a slash at the beginning and the end as well as between each ColorIndex value (-4142 being the numeric value for the xlNone constant).

Also note that the first ColorIndex value is repeated at the end of the text string (this allows the code to endlessly cycle through the ColorIndex values.
 
Last edited:
Upvote 0
Thank you Rick.

I have another question for you guys if you have time.
I inserted a MS date and time picker. I'm in Australia, therefore the format is dd/mm/yyyy.
I have colleagues in LA that will be entering data to this spreadsheet.
Will they see it as mm/dd/yyyy over there or do I have to change the format?
 
Upvote 0
I have another question for you guys if you have time.
I inserted a MS date and time picker. I'm in Australia, therefore the format is dd/mm/yyyy.
I have colleagues in LA that will be entering data to this spreadsheet.
Will they see it as mm/dd/yyyy over there or do I have to change the format?
I am afraid I cannot help you with the above question as I have never been involved with international programming. Hopefully, JoeMo can answer your question. If not, repost it as a new question so that the entirety of volunteers here will have a chance to see it.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,179
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top