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

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

Hi Bernie,

Many thanks for the reply and code, I'm getting a Run-time '1004': Methid 'Range' of object'_Global' failed erroe for the following line:

ReDim Preserve RngArray(1 To j + Range("rngR" & i).Cells.Count)

I can't figure out why, do you have any ideas please?

Andy

Originally Posted by sintek

As you have not uploaded a sample file depicting your actual file setup...It is going to be very difficult answering that question...It all depends on You using Bernie's provided code correctly...

Hi sintek,

This the code from by form.

What I'm trying to do is is use Checkbox1 to 9 to chose which ranges are copied to a word document as an audit report. I've had i working by sending all ranges to the word document as desired, it's just not all
range are required for every use so i want to be able to pick which ranges i send to create the report.

Private Sub CommandButton1_Click()


Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document


    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim msg As String
    Dim boolC As Boolean

    Dim RngArray As Variant



Set RngR1 = Sheet11.Range("B8:F44") 'Checkbox 8
Set RngR2 = Sheet10.Range("B8:F56") 'Checkbox 7
Set RngR3 = Sheet9.Range("B8:F98")  'Checkbox 6
Set RngR4 = Sheet8.Range("B8:F56")  'Checkbox 5
Set RngR5 = Sheet7.Range("B8:F50")  'Checkbox 4
Set RngR6 = Sheet6.Range("B8:F62")  'Checkbox 3
Set RngR7 = Sheet5.Range("B8:F30")  'Checkbox 2
Set RngR8 = Sheet21.Range("B8:F38") 'Checkbox 1
Set RngR9 = Sheet21.Range("B1:F7")  'Checkbox 9

For i = 1 To 9
        If Me.Controls("Checkbox" & i).Value Then
            If Not boolC Then
                j = 0
                boolC = True
            Else
                j = UBound(RngArray)
            End If
            ReDim Preserve RngArray(1 To j + Range("rngR" & i).Cells.Count)
            For k = 1 To Range("rngR" & i).Cells.Count
                RngArray(j + k) = Range("rngR" & i).Cells(k).Value
            Next k
        End If
    Next i
    



Set WrdApp = New Word.Application
    WrdApp.Visible = True
    WrdApp.Activate
    

Set WrdDoc = WrdApp.Documents.Add




For Each Rng In RngArray

   Set ExcRng = Rng
       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)
           

           


End Sub

Many thanks in advance

Andy

Many thanks that has got rid of the error, however it has now thrown up another error in the section code where it loops through copying the ranges to the newly created word document:

For Each Rng In RngArray

   Set ExcRng = Rng
       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)

The error is Run-tine error '424 object required on:

 Set ExcRng = Rng

Andy

Administrative Note:

Welcome to the forum Andy.

We would very much like to help you with your query, however it has been brought to our attention that the same query has been posted on one or more other forums and you have not provided the required cross-post link(s) here. Please note that you have several people chasing around in each place not knowing what the people in the other place are doing, which can create a duplication, and possibly waste, of effort.

Please see Forum Rule #3 about cross-posting and adjust accordingly. Read this to understand why we (and other sites like us) consider this to be important.

(Note: this requirement is not optional. No help to be offered until the link is provided.)

Apologies I wasn’t aware of this requirement, my original query has now been solved via help on the other forum.

Originally Posted by Andyw111

Apologies I wasn’t aware of this requirement, my original query has now been solved via help on the other forum.

This is exactly why we ask you to post a link. We would still like to have the link here so that people get the whole picture if they read your thread.

Please take the time to review our rules. There aren't many, and they are all important.

If your question has been answered please mark your thread as "Solved" so that members will know by looking at the thread title that your problem is solved. Go to the menu immediately above your first post to the thread and click on Thread Tools. From the dropdown menu select "Mark this thread as solved..."

Hi 6StringJazzer

I tried to post the link with my last message but got a message some thing along the lines that I need to post more messages before I can share links or quote posts.

Anyway the final code that does exactly what I was looking for is:

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
    
      
    Set Rng1 = Sheet11.Range("B8:F44")  'Checkbox 1
    Set Rng2 = Sheet10.Range("B8:F56") 'Checkbox 2
    Set Rng3 = Sheet9.Range("B8:F98")  'Checkbox 3
    Set Rng4 = Sheet8.Range("B8:F56")  'Checkbox 4
    Set Rng5 = Sheet7.Range("B8:F50")  'Checkbox 5
    Set Rng6 = Sheet6.Range("B8:F62")  'Checkbox 6
    Set Rng7 = Sheet5.Range("B8:F30")  'Checkbox 7
    Set Rng8 = Sheet21.Range("B8:F38") 'Checkbox 8
    Set Rng9 = Sheet21.Range("B1:F7") 'Checkbox 9
      
    
      
  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)
  

  
  Set WrdApp = New Word.Application
    WrdApp.Visible = True
    WrdApp.Activate
    

Set WrdDoc = WrdApp.Documents.Add

Dim Count1 As Long
Count1 = 0

For Each Rng In RngArray

   Set ExcRng = Rng
       ExcRng.Copy
       
  
   With WrdApp.Selection
        .Range.Paste
        
   Count1 = Count1 + 1
   
 
   
    End With
    
    If Count1 = Count Then
    Exit For
    End If
    
   
   Next
   
  

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

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

Many Thanks

Andy