Loop through Matrix table and store in new sheets of column table

Question

Matrix Table

Column Table

how to convert matrix(not multiple column) to column table in VBA Code?

Sub columntomatrix
Dim mS As Worksheet
Dim eS As Worksheet

Set mS = ThisWorkbook.Sheets("Matrix")
Set eS = ThisWorkbook.Sheets("Price Entry Book")

Dim Matrix() As String
Dim entryPrice() As String
Dim Product As Range
Dim PriceBook As Range
Set Product = Range("Product")
Set PriceBook = Range("PriceBookName")

With mS.Range("B2")
    .Formula = "=IFERROR(INDEX(ListPrice,
    MATCH(" & .Offset(0,-1).Address(False, True) & "&" & 
    .Offset(-1, 0).Address(True, False) & ",ProductKey,0)),"" N/A  "")"


Product.Copy
'offset(0,-1) = selected cells move to left 1 column'
.Offset(0, -1).PasteSpecial

PriceBook.Copy
'offset(-1,0) = selected cells move to up 1 row'
.Offset(-1, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True

With Range(.Offset(0, 0), .Offset(Product.Rows.Count - 2, PriceBook.Rows.Count - 2))
    .FillDown
    .FillRight
End with
End with
End Sub

got to convert this formula to all VBA code.In the same function column to matrix.now i using the formula way, i wish to convert to VBA Coding

https://stackoverflow.com/questions/36365839/transpose-multiple-columns-to-multiple-rows-with-vba/36366394#36366394 — Tim Williams, Oct 30 '20 at 17:06

score 0 · Accepted Answer · answered Oct 30 '20 at 17:36

Here's the Powerquery solution in case you find it easier than the VBA one in the comments. (SO is detecting the instructions as code, even though they aren't)

Make sure every column has a title>highlight your data>insert>add table
Data>from table/range
Select product Name>right click>unpivot other columns
Filter out N/A
Rename columns/arrange order
Add column>duplicate product name and price book
Merge new columns/rename
save&load

Before/After

Code (can be copied into view>advanced editor. Be sure to leave source as whatever your source is)

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Product Name", type text}, {"China Price Book", type text}, {"US Price Book", Int64.Type}, {"UK Price Book", Int64.Type}, {"SG Price Book", Int64.Type}, {"JP Price Book", Int64.Type}, {"Standard Price book", Int64.Type}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Product Name"}, "Attribute", "Value"),
    #"Filtered Rows" = Table.SelectRows(#"Unpivoted Other Columns", each ([Value] <> "N/A")),
    #"Renamed Columns" = Table.RenameColumns(#"Filtered Rows",{{"Attribute", "Price Book"}, {"Value", "List Price"}}),
    #"Reordered Columns" = Table.ReorderColumns(#"Renamed Columns",{"Product Name", "List Price", "Price Book"}),
    #"Duplicated Column" = Table.DuplicateColumn(#"Reordered Columns", "Product Name", "Product Name - Copy"),
    #"Duplicated Column1" = Table.DuplicateColumn(#"Duplicated Column", "Price Book", "Price Book - Copy"),
    #"Merged Columns" = Table.CombineColumns(#"Duplicated Column1",{"Product Name - Copy", "Price Book - Copy"},Combiner.CombineTextByDelimiter("", QuoteStyle.None),"Merged"),
    #"Renamed Columns1" = Table.RenameColumns(#"Merged Columns",{{"Merged", "Product Key"}})
in
    #"Renamed Columns1"

VBasic2008 · Answer 2 · 2020-10-31T18:10:21.917

Unpivot: By Columns, Values Before Headers

Before running the code, adjust the values in the constants section.

The Code

Option Explicit

Sub unpivotData()
    
    ' Define constants.
    
    Const srcName As String = "Matrix"
    Const srcFirst As String = "B1" ' Including headers.
    Const lrCol As Variant = "B"
    Const cCount As Long = 7
    Const repCount As Long = 1
    
    Const tgtName As String = "Price Entry Book"
    Const tgtFirst As String = "A2" ' Excluding headers.
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    ' Define Source Range ('rng').
    
    Dim ws As Worksheet
    Set ws = wb.Worksheets(srcName)
    Dim lRow As Long
    lRow = ws.Cells(ws.Rows.Count, lrCol).End(xlUp).Row
    Dim rCount As Long
    rCount = lRow - ws.Range(srcFirst).Row + 1
    Dim rng As Range
    Set rng = ws.Range(srcFirst).Resize(rCount, cCount)
    
    ' Write values from Source Range to Source Array ('Source').
    
    Dim Source As Variant
    Source = rng.Value
    
    ' Write values from Source Array to Target Array ('Target').
    
    Dim Target As Variant
    ReDim Target(1 To rCount * (cCount - repCount), 1 To repCount + 2)
    
    Dim cVal As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    
    For j = 1 + repCount To cCount
        For i = 2 To rCount
            cVal = Source(i, j)
            If Not IsError(cVal) Then
                If Not IsEmpty(cVal) And cVal <> "N/A" Then
                    k = k + 1
                    For l = 1 To repCount
                        Target(k, l) = Source(i, l)
                    Next l
                    Target(k, l) = cVal
                    Target(k, l + 1) = Source(1, j)
                End If
            End If
        Next i
    Next j
    If k = 0 Then Exit Sub
    
    ' Write values from Target Array to Target Range.
    
    Set ws = wb.Worksheets(tgtName)
    With ws.Range(tgtFirst).Resize(, repCount + 2)
        ' Clear contents below header row.
        .Resize(ws.Rows.Count - ws.Range(tgtFirst).Row + 1).ClearContents
        ' Write values.
        .Resize(k).Value = Target
    End With

    ' Inform user.
    MsgBox "Data transferred.", vbInformation, "Success"

End Sub

Loop through Matrix table and store in new sheets of column table

2 Answers2

Unpivot: By Columns, Values Before Headers