2

I am currently trying to make a system where a user can select some checkboxes that refer to tables and get a consolidated table of the ones that were selected. So far my system generates the checkboxes, checks which ones are ticked, passes that list to another function which is supposed to read the ranges for the tables that have been selected and pass that range to a consolidate function to create the final table.

I'm having trouble getting the consolidation function to work. From what I gather the .Consolidation function requires an array of ranges in string form to work, but no matter how I try to pass the ranges I can't seem to get the function to work for me

Below is the code that generates the array, while also creating a combined table on another worksheet so I could make sure that it is actually running through. The combined table is made without any trouble.

Function rangesfromtables(workinglist() As Variant) As Variant
    Dim tbl As ListObject
    Dim sht As Worksheet
    Dim workingrange As Range
    Dim workingarray() As Variant
    Dim item As Variant
    Dim loopcount As Integer
    Dim destinationsheet As Worksheet
    Dim endrow As Long
    Dim numrows As Long
    Set destinationsheet = ThisWorkbook.Worksheets("WorkingSheet")
    destinationsheet.Cells.Clear
    loopcount = 0
    endrow = 1
    For Each item In workinglist
    'Loop through each sheet and table in the workbook
        For Each sht In ThisWorkbook.Worksheets
            For Each tbl In sht.ListObjects
                If StrComp(item, tbl.name, vbTextCompare) = 0 Then
                    If loopcount = 0 Then
                        Set workingrange = tbl.Range
                        ReDim workingarray(0)
                        workingarray(UBound(workingarray)) = sht.name & tbl.Range.Address(ReferenceStyle:=xlR1C1)
                        loopcount = loopcount + 1
                    Else
                        Set workingrange = tbl.DataBodyRange
                        ReDim Preserve workingarray(UBound(workingarray) + 1)
                        workingarray(UBound(workingarray)) = sht.name & tbl.Range.Address(ReferenceStyle:=xlR1C1)
                    End If
                    numrows = workingrange.Rows.Count 'Below code copies table data to separate worksheet for checking
                    workingrange.Copy
                    destinationsheet.Range("A" & endrow).PasteSpecial Paste:=xlPasteValues

                    endrow = endrow + numrows
                End If
            Next tbl
        Next sht
    Next item
    
    rangesfromtables = workingarray
    
End Function

This is the function that is supposed to consolidate the tables

Sub consolidatetable(workingrange() As Variant)
    Dim destinationsheet As Worksheet

        
    Set destinationsheet = ThisWorkbook.Worksheets("Main Sheet")
    
    destinationsheet.Cells.Clear

    destinationsheet.Range("A6").Consolidate _
        Sources:=workingrange, _
        Function:=x1Sum, _
        TopRow:=True, _
        LeftColumn:=True, _
        CreateLinks:=False

 End Sub

Whenever I run the code I get the error 1004 Consolidate method of Range class failed

I have a feeling that my problem is putting the ranges of the tables into the array incorrectly, but I have tried many different ways and I can't seem to do it. I've tried having a string array instead of variant, tried passing the ranges without modifying them, at the moment I'm attempting to turn the range into a string, but I don't know if I'm doing it correctly.

Any help would be appreciated.

A small update, even when I put a range in manually, I still get the error, but I feel like I'm using the function correctly according to the documentation

Sub consolidatetable(workingrange() As Variant)
    Dim destinationsheet As Worksheet

        
    Set destinationsheet = ThisWorkbook.Worksheets("Main Sheet")
    
    destinationsheet.Cells.Clear

    destinationsheet.Range("A6").Consolidate _
        Sources:="WorkingSheet!A1:J23", _
        Function:=x1Sum, TopRow:=True, LeftColumn:=True, CreateLinks:=False

 End Sub
5
  • At first glance, you seem to be missing a ! after sht.Name and before the table R1C1-Address. Not sure that's going to fix your problem, but that would be a step in the right direction. Also, you might need to add apostrophes (') surrounding the sheet name if they can have spaces in them. Commented Feb 15, 2021 at 3:40
  • If you want to pass arguments manually for testing, make sure that you use an Array and that the addresses you pass in the R1C1 format like so: Sources:=Array("WorkingSheet!R1C1:R23C10","OtherSheet!R1C1:R23C10") Commented Feb 15, 2021 at 3:58
  • Thanks, I did have the format wrong, but even after fixing it I still get the same error! destinationsheet.Range("A6").Consolidate _ Sources:=Array("ESK12!R5C1:R15C9", "ESK12!R19C1:R25C9"), _ Function:=x1Sum, TopRow:=True, LeftColumn:=True, CreateLinks:=False This is doing my head in. Maybe I should give up on consolidate and use a pivot table on the consolidated table I made for testing. I was just hoping to not need to do it that way. Commented Feb 15, 2021 at 4:09
  • Could you share a practical result of the rangesfromtables function? You can do Debug.Print Join(workingarray, ", ") at the end of your function. Your presented ranges are on the same worksheet and of different sizes: that's not what Consolidate handles. Look at DecimalTurn's example: different worksheets but the same range sizes. Commented Feb 15, 2021 at 6:21
  • Oh so consolidate cant work with data ranges on the same worksheet at all? There are multiple tables in different worksheets, some on the same one, I was hoping the consolidate function would work more like the consolidate under the Data tab which seems to be able to take tables from anywhere, even if they are on the same sheet. The microsoft docs just say this "Consolidates data from multiple ranges on multiple worksheets into a single range on a single worksheet." Doesn't mention having limitations of not working on the same sheet, or having longer tables and shorter ones. Pivot table time Commented Feb 15, 2021 at 7:01

2 Answers 2

1

Here's a simple example of a use of the Consolidate method that works for me. Hopefully, this will work on your side and help you see what isn't working, but if it doesn't we'll know that it's not your code that is at fault.

First add the following to Sheet1:

enter image description here

And the following in Sheet2:

enter image description here

Then make sure that Sheet3 is empty and run the following (from a module in the same workbook):

Sub ConsolidateTest()

    Dim rng As Range
    Set rng = ThisWorkbook.Sheets("Sheet3").Cells(1, 1)
       
    rng.Consolidate _
        Sources:=Array("Sheet1!R1C1:R3C3", "Sheet2!R1C1:R3C3"), _
        Function:=-4157, _
        TopRow:=True, _
        LeftColumn:=True, _
        CreateLinks:=False

End Sub

You should then get the following result:

enter image description here

Sign up to request clarification or add additional context in comments.

Comments

0

Thanks for the help guys, sorry about my slow response. In the end I gave up on the built in consolidate function and just made my own. It loops through the combined table that I made just to check that my loop function was working, checks if the first column matches and if it does it sums the 8th columnn, then deletes the original row. The tables I were working with all had the same number of columns, but could be different numbers of rows, some worksheets had multiple tables on them, and no matter how I tried to use the consolidate function it just didn't seem to want to work the same as when you use the Consolidation button under Data in excel.

You can find all of my code below, I have been a bit lazy in commenting out the superfluous code but since I got it working I walked away from it a bit without tidying it up. So if you are ever looking for a way to create a checkbox list for each table you have in a workbook, then combine certain tables and consolidate them, this may help you. The code is a bit of a mess and I'm sure there are more efficient ways of doing what I have done but this way worked for me. I did copy some code from various places, and where I did I tried to leave the comments in.

Private Sub populatelist_Click()
    'Loops through all Tables in workbook
    Call LoopThroughAllTablesinWorkbook
    numofcheckboxes = 0 'reset number of check boxes for rerun
    
End Sub
Private Sub createlist_Click()
    Dim checkedlist() As Variant
    Dim lastrowoftable As Long
    
    
    checkedlist = examinecheckboxes()
    lastrowoftable = rangesfromtables(checkedlist)
    Call consolidatetable(lastrowoftable)
    'MsgBox Join(consolidationrange, vbCrLf)
    
End Sub

Sub LoopThroughAllTablesinWorkbook()

'PURPOSE: Loop through and apply a change to all Tables in the Excel Workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim tbl As ListObject
Dim sht As Worksheet
Dim chkboxleft As Integer
Dim chkboxtop As Integer

chkboxleft = 10
chkboxtop = 20

'Loop through each sheet and table in the workbook
  For Each sht In ThisWorkbook.Worksheets
    For Each tbl In sht.ListObjects
    
    Call createcheckbox(tbl.name, chkboxleft, chkboxtop)
    'move next checkbox down 15pts
    chkboxtop = chkboxtop + 15
    numofcheckboxes = numofcheckboxes + 1
    

        
    Next tbl
  Next sht

End Sub

Sub createcheckbox(name As String, left As Integer, top As Integer)

    'Add Dynamic Checkbox and assign it to object 'Cbx'
    Set Cbx = UserForm1.Controls.Add("Forms.CheckBox.1")
    
    'Assign Checkbox Name
    Cbx.Caption = name
    
    'Checkbox Position
    Cbx.left = left
    Cbx.top = top
    Cbx.Width = 150
    
End Sub
Function examinecheckboxes() As Variant

    'Checks if checkboxes are selected and if they are adds the names of the tables to the array
    Dim checked As Integer
    Dim ctrl As Object
    Dim workingarray() As Variant
    checked = 0
    For Each ctrl In UserForm1.Controls
        
        If TypeName(ctrl) = "CheckBox" Then
            If ctrl.Value = True Then
            
                If checked = 0 Then
                ReDim workingarray(0)
                workingarray(UBound(workingarray)) = ctrl.Caption
                Else
                ReDim Preserve workingarray(UBound(workingarray) + 1)
                workingarray(UBound(workingarray)) = ctrl.Caption
                End If
                
            checked = checked + 1
            
            End If
        End If
    Next ctrl

    examinecheckboxes = workingarray
End Function
Function rangesfromtables(workinglist() As Variant) As Long
    Dim tbl As ListObject
    Dim sht As Worksheet
    Dim workingrange As Range
    Dim workingarray() As Variant
    Dim item As Variant
    Dim loopcount As Integer
    Dim destinationsheet As Worksheet
    Dim endrow As Long
    Dim numrows As Long
    Set destinationsheet = ThisWorkbook.Worksheets("WorkingSheet")
    destinationsheet.Cells.Clear 'Clear Workingsheet so unneeded data isnt included
    loopcount = 0
    endrow = 1
    For Each item In workinglist
    'Loop through each sheet and table in the workbook
        For Each sht In ThisWorkbook.Worksheets
            For Each tbl In sht.ListObjects
                If StrComp(item, tbl.name, vbTextCompare) = 0 Then
                    If loopcount = 0 Then
                        Set workingrange = tbl.Range
                        ReDim workingarray(0)
                        workingarray(UBound(workingarray)) = sht.name & "!" & tbl.Range.Address(ReferenceStyle:=xlR1C1) 'format sheet name and table range for consolidate function to work
                        loopcount = loopcount + 1
                    Else
                        Set workingrange = tbl.DataBodyRange
                        ReDim Preserve workingarray(UBound(workingarray) + 1)
                        workingarray(UBound(workingarray)) = sht.name & "!" & tbl.Range.Address(ReferenceStyle:=xlR1C1)
                    End If
                    numrows = workingrange.Rows.Count 'Below code copies table data to separate worksheet for checking
                    workingrange.Copy
                    destinationsheet.Range("A" & endrow).PasteSpecial Paste:=xlPasteValues

                    endrow = endrow + numrows
                End If
            Next tbl
        Next sht
    Next item
    
    rangesfromtables = endrow
    
End Function
Sub consolidatetable(lastrow As Long)
    Dim destinationsheet As Worksheet
    Dim sourcesheet As Worksheet

        
    Set destinationsheet = ThisWorkbook.Worksheets("Main Sheet")
    Set sourcesheet = ThisWorkbook.Worksheets("WorkingSheet")
    
    destinationsheet.Cells.Clear
    

    
    For x = lastrow To 2 Step -1
    For y = 2 To lastrow
        If sourcesheet.Cells(x, 1).Value = sourcesheet.Cells(y, 1).Value And x > y Then
            sourcesheet.Cells(y, 8).Value = sourcesheet.Cells(x, 8).Value + sourcesheet.Cells(y, 8).Value
            sourcesheet.Rows(x).EntireRow.Delete
            Exit For
        End If
    Next y
Next x

    sourcesheet.Range("A1:A" & lastrow).Copy destinationsheet.Range("A7:A" & (lastrow + 7))
    sourcesheet.Range("H1:I" & lastrow).Copy destinationsheet.Range("B7:C" & (lastrow + 7))

'    destinationsheet.Range("A6").Consolidate _
'       Sources:=Array("ESK12!R5C1:R15C9", "ESK12!R19C1:R25C9"), _
'       Function:=x1Sum, TopRow:=True, LeftColumn:=False, CreateLinks:=False

 End Sub
`

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.