How to assembly a matrix with VBA

[tazz]

Hello all,
I need help with a matrix assembly. I have a number of matrices with headers named a1, b1, a2, etc and rows matching the headers. I would like the assembly matrix to get in cell corresponding to a1a1 all the values from the matrices and so on until all the values from all matrices go on the right spot. I did this for only 3 matrices (3x3) using index and match but every time I add another matrix I have to rewrite the code.
For a better understanding I attached the file format of my sheet.
Thank you

 

[Marc L]

Hi !

I have to rewrite the code.

Could be easier if you share this code or, better,
a workbook attachment with data to see the result …
​

 

[NARAYANK991]

Hi ,

In addition to what has been posted , can you clarify the following ?

1. You mention a 3 x 3 matrix , but the uploaded file shows all the input matrices to be 4 x 4 ; which is correct ?

2. You have labels above each matrix , indicating the slots as a1 , b1 , a2 , b2 and so on ; if a fourth matrix were to be added to the existing 3 ( shown in the uploaded file ) , would the slots be a4 , b4 , a5 , b5 ?

3. Will the output matrix increase in width and height each time an input matrix is added ?

Narayan

 

[Chihiro]

Not sure if this is most efficient. But here's the code.

Sub MatrixTest()
Dim tbl As ListObject
Dim cel As Range
Dim Dict As Object, cDict As Object, rDict As Object
Dim i As Integer, j As Integer

Set cDict = CreateObject("Scripting.Dictionary")
For Each tbl In ActiveSheet.ListObjects
    With tbl
    For Each cel In .Range.Resize(1, .Range.Columns.Count - 1)
        If cDict.exists(cel.Value) Then
            With .DataBodyRange.Columns(.Range.Columns.Count)
                For i = 1 To 4
                    cDict.Item(cel.Value).Item(.Cells(i).Value) = .Cells(i).Offset(, -(6 - cel.Column)).Value
                Next i
            End With
        Else
            Set rDict = CreateObject("Scripting.Dictionary")
            With .DataBodyRange.Columns(.Range.Columns.Count)
                For i = 1 To 4
                    rDict.Item(.Cells(i).Value) = .Cells(i).Offset(, -(6 - cel.Column)).Value
                Next i
                cDict.Add Item:=rDict, Key:=cel.Value
            End With
        End If
    Next cel
    End With
Next tbl

With Worksheets("Sheet1")
    .Range("K1").Resize(1, cDict.Count) = cDict.Keys
    .Range("K1").Offset(1, cDict.Count).Resize(cDict.Count, 1) = Application.Transpose(cDict.Keys)
    With .Range("K1").Resize(1, cDict.Count)
        For i = 1 To cDict.Count
            For j = 1 To cDict.Count
                .Cells(i).Offset(j, 0).Value = cDict.Item(.Cells(i).Value).Item(.Cells(j).Value)
            Next
        Next i
    End With
End With

Set cDict = Nothing
End Sub

You will need to convert each added matrix to table.
Also adjust "K1" to some other cell as needed.

See attached for demo (hit calculate).

 

[Chihiro]

Woops. Previous code was missing Sum operation

Revised code and file.

Sub MatrixTest()
Dim tbl As ListObject
Dim cel As Range
Dim cDict As Object, rDict As Object
Dim i As Integer, j As Integer

Set cDict = CreateObject("Scripting.Dictionary")
For Each tbl In ActiveSheet.ListObjects
    With tbl
    For Each cel In .Range.Resize(1, .Range.Columns.Count - 1)
        If cDict.exists(cel.Value) Then
            With .DataBodyRange.Columns(.Range.Columns.Count)
                For i = 1 To tbl.Range.Columns.Count - 1
                    cDict.Item(cel.Value).Item(.Cells(i).Value) = cDict.Item(cel.Value).Item(.Cells(i).Value) + .Cells(i).Offset(, -(6 - cel.Column)).Value
                Next i
            End With
        Else
            Set rDict = CreateObject("Scripting.Dictionary")
            With .DataBodyRange.Columns(.Range.Columns.Count)
                For i = 1 To 4
                    rDict.Item(.Cells(i).Value) = .Cells(i).Offset(, -(6 - cel.Column)).Value
                Next i
                cDict.Add Item:=rDict, Key:=cel.Value
            End With
        End If
    Next cel
    End With
Next tbl

With Worksheets("Sheet1")
    .Range("K1").Resize(1, cDict.Count) = cDict.Keys
    .Range("K1").Offset(1, cDict.Count).Resize(cDict.Count, 1) = Application.Transpose(cDict.Keys)
    With .Range("K1").Resize(1, cDict.Count)
        For i = 1 To cDict.Count
            For j = 1 To cDict.Count
                .Cells(i).Offset(j, 0).Value = cDict.Item(.Cells(i).Value).Item(.Cells(j).Value)
            Next
        Next i
    End With
End With

Set cDict = Nothing
End Sub

 

[Frano]

Hi. The code above is just what I was going after since I am manipulating with matrices in FEM currently on spreadsheet only and this would be the way to go in VBA. I am still learning VBA and I would appreciate if you could just please make comments to the code as where the elements from the matrices are read, where they are stored, and how the final matrix is formed, maybe how it would look like written as function (UDF) with final output on sheet?
Thank you in advance

Frano

 

[Chihiro]

Sorry, I'm extremely busy at work. Won't be able to spend time on forum until I'm done with the current project. Likely week or two.