Searching for Macro

[Bernsch76]

Dear community,

I am not a VBA specialist, so I hope that you can help me with the following task:

My Excel version: Excel 365

I attached the file where you can find an example of input data and the desired output.Each column of the input should be displayed with the corresponding row values ​​in one row. So the output should have as many rows as there are columns in the input. If the input values are NULL or EMPTY, they should not be seen in the output.

It would also be important that the input matrix can be of any size, it can have any number of columns and rows.


Thank you!
Best regards
Bernhard

[Bob Phillips]

If a small layout change is okay, it is simple with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"C1", Int64.Type}, {"C2", Int64.Type}, {"C3", Int64.Type}, {"C4", Int64.Type}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Column1"}, "Attribute", "Value"),
    #"Pivoted Column" = Table.Pivot(#"Unpivoted Other Columns", List.Distinct(#"Unpivoted Other Columns"[Column1]), "Column1", "Value", List.Sum)
in
    #"Pivoted Column"

[snb]

I'd prefer another unpivot result.

Sub M_snb()
   sn = Tabelle1.Cells(1).CurrentRegion
   ReDim sp((UBound(sn) - 1) * (UBound(sn, 2) - 1), 3)
   
   For j = 0 To UBound(sp) - 1
      x = j \ (UBound(sn, 2) - 1) + 2
      y = j Mod (UBound(sn, 2) - 1) + 2
      sp(j, 0) = sn(1, y)
      sp(j, 1) = sn(x, 1)
      sp(j, 2) = sn(x, y)
   Next
   
   Tabelle1.Cells(10, 1).Resize(UBound(sp), 3) = sp
End Sub

[mana]

Option Explicit


Sub test()
    Dim dic As Object
    Dim v, j As Long, k As Long, s As String
    
    Set dic = CreateObject("scripting.dictionary")
    v = Tabelle1.Cells(1).CurrentRegion.Value
    
    For k = 2 To UBound(v, 2)
        s = v(1, k)
        For j = 2 To UBound(v, 1)
            If Not IsEmpty(v(j, k)) Then
                dic(s) = dic(s) & vbTab & v(j, 1) & vbTab & v(j, k)
            End If
        Next
    Next
    With Worksheets.Add.Columns(1)
        .Resize(dic.Count).Value = Application.Transpose(dic.items)
        .TextToColumns DataType:=xlDelimited, Tab:=True, Other:=False
        .Resize(dic.Count).Value = Application.Transpose(dic.keys)
    End With
    
End Sub

[p45cal]

Another Power Query offering:
NewTable:

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Column1"}, "Attribute", "Value"),
    #"Reordered Columns" = Table.ReorderColumns(#"Unpivoted Other Columns",{"Attribute", "Column1", "Value"}),
    #"Grouped Rows" = Table.Group(#"Reordered Columns", {"Attribute"}, {{"Count", each _, type table [Attribute=text, Column1=text, Value=number]}}),
    #"Invoked Custom Function" = Table.AddColumn(#"Grouped Rows", "fnmyTbl", each fnmyTbl([Count])),
    #"Removed Columns" = Table.RemoveColumns(#"Invoked Custom Function",{"Count"}),
    AddedCustom = Table.AddColumn(#"Removed Columns", "ColmCount", each Table.ColumnCount([fnmyTbl])),
    Max = List.Max(AddedCustom[ColmCount]),
    Names = List.Transform({1..Max},each "M." & Text.From(_)),
    #"Removed Columns1" = Table.RemoveColumns(AddedCustom,{"ColmCount"}),
    #"Expanded fnmyTbl" = Table.ExpandTableColumn(#"Removed Columns1", "fnmyTbl",Names)
in
    #"Expanded fnmyTbl"

fnmyTbl:

(tbl)=>
let
    MergedColumns = Table.CombineColumns(Table.TransformColumnTypes(tbl, {{"Value", type text}}, "en-GB"),{"Column1", "Value"},Combiner.CombineTextByDelimiter("¬", QuoteStyle.None),"M"),
    RemovedColumns = Table.RemoveColumns(MergedColumns,{"Attribute"}),
    TransposedTable = Table.Transpose(RemovedColumns),
    MergedColumns1 = Table.CombineColumns(TransposedTable,Table.ColumnNames(TransposedTable),Combiner.CombineTextByDelimiter("¬", QuoteStyle.None),"M"),
    SplitColumnbyDelimiter = Table.SplitColumn(MergedColumns1, "M", Splitter.SplitTextByDelimiter("¬", QuoteStyle.Csv), Table.RowCount(MergedColumns)*2)
in
    SplitColumnbyDelimiter

2020-06-15_205353.jpg

[Bernsch76]

Another Power Query offering:
NewTable:

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Column1"}, "Attribute", "Value"),
    #"Reordered Columns" = Table.ReorderColumns(#"Unpivoted Other Columns",{"Attribute", "Column1", "Value"}),
    #"Grouped Rows" = Table.Group(#"Reordered Columns", {"Attribute"}, {{"Count", each _, type table [Attribute=text, Column1=text, Value=number]}}),
    #"Invoked Custom Function" = Table.AddColumn(#"Grouped Rows", "fnmyTbl", each fnmyTbl([Count])),
    #"Removed Columns" = Table.RemoveColumns(#"Invoked Custom Function",{"Count"}),
    AddedCustom = Table.AddColumn(#"Removed Columns", "ColmCount", each Table.ColumnCount([fnmyTbl])),
    Max = List.Max(AddedCustom[ColmCount]),
    Names = List.Transform({1..Max},each "M." & Text.From(_)),
    #"Removed Columns1" = Table.RemoveColumns(AddedCustom,{"ColmCount"}),
    #"Expanded fnmyTbl" = Table.ExpandTableColumn(#"Removed Columns1", "fnmyTbl",Names)
in
    #"Expanded fnmyTbl"

fnmyTbl:

(tbl)=>
let
    MergedColumns = Table.CombineColumns(Table.TransformColumnTypes(tbl, {{"Value", type text}}, "en-GB"),{"Column1", "Value"},Combiner.CombineTextByDelimiter("¬", QuoteStyle.None),"M"),
    RemovedColumns = Table.RemoveColumns(MergedColumns,{"Attribute"}),
    TransposedTable = Table.Transpose(RemovedColumns),
    MergedColumns1 = Table.CombineColumns(TransposedTable,Table.ColumnNames(TransposedTable),Combiner.CombineTextByDelimiter("¬", QuoteStyle.None),"M"),
    SplitColumnbyDelimiter = Table.SplitColumn(MergedColumns1, "M", Splitter.SplitTextByDelimiter("¬", QuoteStyle.Csv), Table.RowCount(MergedColumns)*2)
in
    SplitColumnbyDelimiter

2020-06-15_205353.jpg