Combinng Ranges into One

[Dhanosa]

Hello I am new to VBA and I am trying to make a spreadsheet with checkboxes but it was becoming slow and unresponsive and I stumbled upon creating cells as checkboxes. When I put the code in I can get it to work for one row or one of my named ranges as I couldn't get all of the cells into a single range. My trouble comes when trying to apply the code over multiple named ranges as I don't know how to combine them. I found and edited a union code that works in combining the cells into a master range but then the code for the checkbox fails. I have attached a screenshot and any advice would be appreciated.

Thanks

Damon

-----

Sub MultipleRange()
Dim r1 As Range, r2 As Range, myMultipleRange As Range
Set r1 = Sheets("Tracker").Range("EngageConfirm1")
Set r2 = Sheets("Tracker").Range("MeetPrep1")
Set r3 = Sheets("Tracker").Range("EngageConfirm2")
Set r4 = Sheets("Tracker").Range("MeetPrep2")
Set r5 = Sheets("Tracker").Range("MeetPrep3")
Set r6 = Sheets("Tracker").Range("MeetPrep4")
Set r7 = Sheets("Tracker").Range("MeetPrep5")
Set r8 = Sheets("Tracker").Range("Status1")
Set r9 = Sheets("Tracker").Range("Status2")
Set r10 = Sheets("Tracker").Range("Status3")
Set r11 = Sheets("Tracker").Range("Status4")
Set r12 = Sheets("Tracker").Range("Status5")
Set r13 = Sheets("Tracker").Range("Status6")
Set r14 = Sheets("Tracker").Range("Status7")
Set r15 = Sheets("Tracker").Range("Status8")
Set r16 = Sheets("Tracker").Range("Status9")
Set r17 = Sheets("Tracker").Range("Status10")
Set r18 = Sheets("Tracker").Range("Status11")
Set r19 = Sheets("Tracker").Range("Status12")
Set r20 = Sheets("Tracker").Range("Status13")
Set r21 = Sheets("Tracker").Range("Status14")
Set r22 = Sheets("Tracker").Range("Status15")
Set r23 = Sheets("Tracker").Range("Status16")
Set r24 = Sheets("Tracker").Range("Status17")
Set r25 = Sheets("Tracker").Range("Status18")
Set r26 = Sheets("Tracker").Range("Status19")
Set r27 = Sheets("Tracker").Range("Status20")
Set r28 = Sheets("Tracker").Range("ConfirmAP")
Set myMultipleRange = Union(r1, r2, r3, r4, r5, 56, r7, r8, r9, r10, r11, r12, r13, r14, r15, r16, r17, r18, r19, r20, r21, r22, r23, r24, r25, r26, r27, r28)
myMultipleRange
End Sub


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("myMultipleRange")) 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

[p45cal]

run this once:
Sub MultipleRange()
Set r1 = Sheets("Tracker").Range("EngageConfirm1")
Set r2 = Sheets("Tracker").Range("MeetPrep1")
Set r3 = Sheets("Tracker").Range("EngageConfirm2")
Set r4 = Sheets("Tracker").Range("MeetPrep2")
Set r5 = Sheets("Tracker").Range("MeetPrep3")
Set r6 = Sheets("Tracker").Range("MeetPrep4")
Set r7 = Sheets("Tracker").Range("MeetPrep5")
Set r8 = Sheets("Tracker").Range("Status1")
Set r9 = Sheets("Tracker").Range("Status2")
Set r10 = Sheets("Tracker").Range("Status3")
Set r11 = Sheets("Tracker").Range("Status4")
Set r12 = Sheets("Tracker").Range("Status5")
Set r13 = Sheets("Tracker").Range("Status6")
Set r14 = Sheets("Tracker").Range("Status7")
Set r15 = Sheets("Tracker").Range("Status8")
Set r16 = Sheets("Tracker").Range("Status9")
Set r17 = Sheets("Tracker").Range("Status10")
Set r18 = Sheets("Tracker").Range("Status11")
Set r19 = Sheets("Tracker").Range("Status12")
Set r20 = Sheets("Tracker").Range("Status13")
Set r21 = Sheets("Tracker").Range("Status14")
Set r22 = Sheets("Tracker").Range("Status15")
Set r23 = Sheets("Tracker").Range("Status16")
Set r24 = Sheets("Tracker").Range("Status17")
Set r25 = Sheets("Tracker").Range("Status18")
Set r26 = Sheets("Tracker").Range("Status19")
Set r27 = Sheets("Tracker").Range("Status20")
Set r28 = Sheets("Tracker").Range("ConfirmAP")
Union(r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, r13, r14, r15, r16, r17, r18, r19, r20, r21, r22, r23, r24, r25, r26, r27, r28).Name = "myMultipleRange"
End Sub
It will set up a named range called myMultipleRange which you'll be able to see in the Name Manager. It will remain in the workbook unless you actively remove it, so unless you want to change that range you never need run that code again.

Your Worksheet_BeforeDoubleClick event should then work without alteration.

You don't really need all those variables, you code could be:

Sub MultipleRange2()
Union(Range("EngageConfirm1"), Range("MeetPrep1"), Range("EngageConfirm2"), Range("MeetPrep2"), Range("MeetPrep3"), Range("MeetPrep4"), Range("MeetPrep5"), Range("Status1"), Range("Status2"), Range("Status3"), Range("Status4"), Range("Status5"), Range("Status6"), Range("Status7"), Range("Status8"), Range("Status9"), Range("Status10"), Range("Status11"), Range("Status12"), Range("Status13"), Range("Status14"), Range("Status15"), Range("Status16"), Range("Status17"), Range("Status18"), Range("Status19"), Range("Status20"), Range("ConfirmAP")).Name = "myMultipleRange"
End Sub


ps. You're not supposed to tack a new question onto someone else's thread (it's called hijacking), you should've started your own new one.:)

[Dhanosa]

Thank you p45cal for solving my issue, it works and much appreciated :D