Consulting

Results 1 to 3 of 3

Thread: Combinng Ranges into One

  1. #1
    VBAX Newbie
    Joined
    Jan 2023
    Posts
    2
    Location

    Combinng Ranges into One

    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
    Attached Images Attached Images
    Last edited by Aussiebear; 01-06-2023 at 04:15 AM. Reason: Added code tags to supplied code

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,875
    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.
    Last edited by p45cal; 01-06-2023 at 04:19 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Newbie
    Joined
    Jan 2023
    Posts
    2
    Location
    Thank you p45cal for solving my issue, it works and much appreciated

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •