Intersect with multiple ranges

[SanDana]

I'm new to VBA so any help would be greatly appreciated...

I'm using code found on this site for adding a checkmark to a cell when the cell is double-clicked. It works great for one range of cells but how do I get it to work for multiple ranges?

My spreadsheet looks like this:
Range A10:A20 named SLCkBoxes- Cells to double click for checkmark
Range B10:B20 - List of Departments
Range C10:C30 named PosCkBoxes1 - Cells to double click for checkmark
Range D10:20 - List of Job Titles
Range E10:E20 named PosCkBoxes2 - Cells to double click for checkmark
Range F:10:F20 - Continued list of Job Titles

If put all of this in one column it would be too long...

Here's the code I'm using which works for the named range SLCkBoxes. How do I get this to work for the other ranges as well?


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("SLCkBoxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets target Value = ""
Cancel = True
Exit Sub
End If
End Sub

[Bob Phillips]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("SLCkBoxes", "PosCkBoxes1", "PosCkBoxes2")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets target Value = ""
Cancel = True
Exit Sub
End If
End Sub

[lucas]

You will have to use union. In the attached I added range J1:J3 just to show you how to continue....that range was not included in the original example.

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim CheckmarkCells As Range
Set CheckmarkCells = Union(Range("C2:C54"), [H2:H54], [J1:J3])
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
If Target.Font.Name = "Marlett" Then
Target.ClearContents
Target.Font.Name = "Arial"
Target.Offset(0, 1).Select
Else
Target.Value = "a"
Target.Font.Name = "Marlett"
Target.Offset(0, 1).Select
End If
End If
End Sub

ps. if you select your code when posting and hit the vba button, the code will be formatted for the forum. I will edit your post.

[lucas]

Bob beat me to it and he addressed the named ranges, mine did not. By using the named ranges you avoid the need to use union, is that correct Bob? You used intersect instead. Any advantage one way or the other?

[SanDana]

Using Union worked great. I did use the Target.Font.Name command and the 2 If statements that followed it from my original post. Without making this switch I could not uncheck a cell by double clicking.

thanks to all who responded.

[mdmackillop]

Hi SanDanam
Lucas omitted Cancel = True from his code. Add this in at the end to uncheck the cell.

[lucas]

Malcolm is right. I took the code from a sheet selection code which doesn't respond to cancel = True so I use the offset line.

replace this:
Target.Offset(0, 1).Select
with

cancel = true