Add Range/s to Array Based on CheckBox value being True

[Andyw111]

Hi All,

I hope so one can help me, I have a UserForm with 9 Checkboxes (1 to9) and each Checkbox relates to a specific range of cells from 9 separate worksheets.

I have set the ranges to Rng1 to Rng9

I want to add only the ranges (Rng1 to Rng9) that have been checked as true to an array called RngArray.

Is there any easy way to loop through the checkboxes and only add those that have been checked to the array?

Many thanks in advance.

Andy

 

[Domenic]

If I understood you correctly, your checkboxes are named CheckBox1, CheckBox2, and so on until CheckBox9. Is this correct? If so, try something like this...

    Dim AllRanges As Variant
    AllRanges = Array(Rng1, Rng2, Rng3, Rng4, Rng5, Rng6, Rng7, Rng8, Rng9)
   
    ReDim RngArray(UBound(AllRanges)) As Range
   
    Dim Count As Long
    Count = 0
   
    Dim i As Long
    For i = LBound(AllRanges) To UBound(AllRanges)
        If Me.Controls("CheckBox" & i + 1).Value = True Then
            Set RngArray(Count) = AllRanges(i)
            Count = Count + 1
        End If
    Next i
   
    If Count > 0 Then
        ReDim Preserve RngArray(Count)
        'do stuff here
        '
        '
    Else
        MsgBox "No checkboxes selected!", vbExclamation
    End If

Hope this helps!

 

[Andyw111]

If I understood you correctly, your checkboxes are named CheckBox1, CheckBox2, and so on until CheckBox9. Is this correct? If so, try something like this...

    Dim AllRanges As Variant
    AllRanges = Array(Rng1, Rng2, Rng3, Rng4, Rng5, Rng6, Rng7, Rng8, Rng9)
  
    ReDim RngArray(UBound(AllRanges)) As Range
  
    Dim Count As Long
    Count = 0
  
    Dim i As Long
    For i = LBound(AllRanges) To UBound(AllRanges)
        If Me.Controls("CheckBox" & i + 1).Value = True Then
            Set RngArray(Count) = AllRanges(i)
            Count = Count + 1
        End If
    Next i
  
    If Count > 0 Then
        ReDim Preserve RngArray(Count)
        'do stuff here
        '
        '
    Else
        MsgBox "No checkboxes selected!", vbExclamation
    End If

Hope this helps!

Hi Domenic,

Many thanks for the swift reply, i have tried your code and I'm getting a Run-time error '424': Object required for the following line of code:

Set RngArray(Count) = AllRanges(i)

I can't figure out why, any ideas?

Andy

 

[Domenic]

How did you define your ranges (Rng1 to Rng9) ?

Actually, can you post the complete code that you're using?

 

[Andyw111]

Hi
What I've done is created an audit capture tool using UserForms which then writes it a worksheet, from there the data is copied to other worksheets to form an audit report. From there is want this code to copy the data in the ranges on each sheet to an array if the relevant checkbox is ticked, the reason for this is that not all section are required for each audit. Then it will paste to a newly created word document (I'm not sure if my copy and paste method will work with your code?)

Here is the entire code I'm working with for this function:

Private Sub CommandButton1_Click()
    
    Dim WrdApp As Word.Application
    Dim WrdDoc As Word.Document
    Dim ExcRng As Range
    Dim Rng As Variant
    
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range
    Dim Rng4 As Range
    Dim Rng5 As Range
    Dim Rng6 As Range
    Dim Rng7 As Range
    Dim Rng8 As Range
    Dim Rng9 As Range
 
  Dim AllRanges As Variant
    AllRanges = Array(Rng1, Rng2, Rng3, Rng4, Rng5, Rng6, Rng7, Rng8, Rng9)
    
    Set Rng1 = Sheet11.Range("B8:F44") 'Checkbox 8
    Set Rng2 = Sheet10.Range("B8:F56") 'Checkbox 7
    Set Rng3 = Sheet9.Range("B8:F98")  'Checkbox 6
    Set Rng4 = Sheet8.Range("B8:F56")  'Checkbox 5
    Set Rng5 = Sheet7.Range("B8:F50")  'Checkbox 4
    Set Rng6 = Sheet6.Range("B8:F62")  'Checkbox 3
    Set Rng7 = Sheet5.Range("B8:F30")  'Checkbox 2
    Set Rng8 = Sheet21.Range("B8:F38") 'Checkbox 1
    Set Rng9 = Sheet21.Range("B1:F7")  'Checkbox 9
  
    ReDim RngArray(UBound(AllRanges)) As Range
  
    Dim Count As Long
    Count = 0
  
    Dim i As Long
    For i = LBound(AllRanges) To UBound(AllRanges)
        If Me.Controls("CheckBox" & i + 1).Value = True Then
            Set RngArray(Count) = AllRanges(i)
            Count = Count + 1
        End If
    Next i
  
    If Count > 0 Then
        ReDim Preserve RngArray(Count)
 
 
 
  Set WrdApp = New Word.Application
    WrdApp.Visible = True
    WrdApp.Activate
    

Set WrdDoc = WrdApp.Documents.Add




Dim ExcRng As Range


For Each Rngr In RngArray

   Set ExcRng = RngArray
       ExcRng.Copy
      
 
  
   Application.Wait Now() + #12:00:02 AM#
  

  
   With WrdApp.Selection
        .Range.Paste
        

 
  
    End With
    
  
  Next

  Set WordTable = WrdDoc.Tables(1)
           WordTable.AutoFitBehavior (wdAutoFitWindow)
          

          
    Else
        MsgBox "No checkboxes selected!", vbExclamation
    End If
    
End Sub

Hopefully you will be able to assist this have been driving me bad for over a month now.

Many thanks

Andy

 

[Domenic]

Try to define your ranges before assigning them to AllRanges...

    '
    '
    '

    Set Rng1 = Sheet11.Range("B8:F44") 'Checkbox 8
    Set Rng2 = Sheet10.Range("B8:F56") 'Checkbox 7
    Set Rng3 = Sheet9.Range("B8:F98")  'Checkbox 6
    Set Rng4 = Sheet8.Range("B8:F56")  'Checkbox 5
    Set Rng5 = Sheet7.Range("B8:F50")  'Checkbox 4
    Set Rng6 = Sheet6.Range("B8:F62")  'Checkbox 3
    Set Rng7 = Sheet5.Range("B8:F30")  'Checkbox 2
    Set Rng8 = Sheet21.Range("B8:F38") 'Checkbox 1
    Set Rng9 = Sheet21.Range("B1:F7")  'Checkbox 9
   
    Dim AllRanges As Variant
    AllRanges = Array(Rng1, Rng2, Rng3, Rng4, Rng5, Rng6, Rng7, Rng8, Rng9)
   
    '
    '
    '

 

[Andyw111]

Hi thanks that's cleared that error.

The code below yours that copies it to the word document is now not working, i don't think this is compatible with your suggested code, any suggestions on how to copy the collect data and paste to the new word document?

 

[Domenic]

In taking a quick look, I see a couple of issues...

1) you've declared ExcRng twice, so you should be getting an error telling you that you have a duplicate declaration. So remove the second declaration from your code.

2) you're assigning RngArray to ExcRng, whereas you should be assigning Rngr instead...

Set ExcRng = Rngr

I would also suggest placing the following statement at the very top of your module before any code...

Option Explicit

This forces the explicit declaration of variables and will help catch some errors.

 

[Fluff]

Cross posted Add Range/s to Array Based on CheckBox value being True

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered elsewhere.

 

[Andyw111]

In taking a quick look, I see a couple of issues...

1) you've declared ExcRng twice, so you should be getting an error telling you that you have a duplicate declaration. So remove the second declaration from your code.

2) you're assigning RngArray to ExcRng, whereas you should be assigning Rngr instead...

Set ExcRng = Rngr

I would also suggest placing the following statement at the very top of your module before any code...

Option Explicit

This forces the explicit declaration of variables and will help catch some errors.

Thank you for the response that solved this issue, however if all checkbox aren't ticked it doesn't exit the loop and gives a Run-time error 91 Object variable or With block not set.

I'm assume it requires some way of exiting the loop if there nothing to copy, but have no idea how to do this, this is the code that I'm talking about:

For Each Rng In RngArray

   Set ExcRng = Rng
  
 
    
      ExcRng.Copy
      
       
    
    
   With WrdApp.Selection
        .Range.Paste
        

  
    End With
    
  
   Next

many thanks Andy