arraysexcelvbaconsolidation

Consolidation by Sum from Array


I have been having a difficulty with the final stage of code for consolidating data by sum from an array of worksheets (dynamically created).

The code returns an error 1004: Consolidate method of Range class failed

Probably, I am setting the array entries to unsupported values (is R1C1 reference style necessary, for example)? Please help.

P.S. I can probably go with one cycle only to populate array, I shall try figure this out later.

Thanks to guys previously contributing to similar requests:

Create Excel Consolidated Worksheet with multiple sources in VBA

adding values to variable array VBA

Here is the code:

Sub Consolidate_ALL_Click_2()

Dim ws As Worksheet
Dim wArr, siArr As Variant
ReDim siArr(0 To 0)

'--- Run through all sheets in workbook
For Each ws In Worksheets 
  For Each wArr In Array("A", "B", "C", "D")
'--- Check if worksheet name is in matching the list
    If ws.Name = wArr Then
       ReDim Preserve siArr(UBound(siArr) + 1)
'--- Write address to array
       siArr(UBound(siArr)) = ws.Range("A10:C300").Address(ReferenceStyle:=XlReferenceStyle.xlA1, external:=True)
    End If
  Next wArr
Next ws

'--- Consolidate, using pre-defined array of Ranges        
Worksheets("SUMMARY").Range("A10").Consolidate Sources:=Array(siArr), _
Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False

End Sub

Solution

  • The manner in which you are creating siArr ensures that siArr(0) will always be empty. Hence theConsolidate` method will fail on the empty item.

    Edit: Looking at another issue, you do, indeed, need to use the R1C1 reference style as stated in HELP for that topic.

    If you are going to use the ReDim Preserve method, then try:

    '--- Run through all sheets in workbook
    For Each ws In Worksheets
      For Each wArr In Array("A", "B", "C", "D")
    '--- Check if worksheet name is in matching the list
        If ws.Name = wArr Then
            If Not IsEmpty(siArr(UBound(siArr))) Then _
           ReDim Preserve siArr(UBound(siArr) + 1)
    '--- Write address to array
           siArr(UBound(siArr)) = ws.Range("A10:C300").Address(ReferenceStyle:=XlReferenceStyle.xlR1C1, external:=True)
        End If
      Next wArr
    Next ws
    

    I usually use the Dictionary or Collection object to collect a list of objects/variables of unknown size; and then reDim my array just once when done, avoiding ReDim Preserve completely. Your referenced method will leave an empty element at the end of the array. Your method here leaves an empty element at the beginning of the array. Both are avoided by using a Dictionary or Collection object

    So you could use instead:

    Dim ws As Worksheet
    Dim wArr, siArr As Variant
    Dim cWS As Collection
    
    Set cWS = New Collection
    '--- Run through all sheets in workbook
    For Each ws In Worksheets
      For Each wArr In Array("A", "B", "C", "D")
    '--- Check if worksheet name is in matching the list
        If ws.Name = wArr Then
    '--- Add address to collection
           cWS.Add ws.Range("A10:C300").Address(ReferenceStyle:=XlReferenceStyle.xlR1C1, external:=True)
        End If
      Next wArr
    Next ws
    
    '--- write addresses to array
    Dim I As Long
    ReDim siArr(0 To cWS.Count - 1)
    For Each wArr In cWS
        siArr(I) = wArr
        I = I + 1
    Next wArr