Dhanosa
01-06-2023, 01:53 AM
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
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