Reverse Pivot Macro

[doriannjeshi]

Hi ,
I need a reverse macro pivot for this case, no headers, just column A items repeated for each value in respective rows

ex1	AQT	BTG		ATO	ARI		AVL	ADR	AFR	AKO	ASH	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex2	AQT	BTG		ATO	ARI		AVL	ADR	AFR	AKO
ex3	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex4	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex5	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex6	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex7	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex8	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex9	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex10	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex11	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex12	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex13	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex14	ALU	ALE		ITG	ITO	IMS	IVL	IOX		IDR	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex15	ALU
ex16	ALU
ex17	ALU	ALE		ITG	ITO	IMS	IVL
ex18	ALU	ALE		ITG	ITO	IMS	IVL
ex19	ALU	ALE		ITG	ITO	IMS	IVL
ex20	ALU	ALE		ITG	ITO	IMS	IVL
ex21	ALU	ALE		ITG	ITO	IMS	IVL
ex22	ALU	ALE		ITG	ITO	IMS	IVL
ex23	ALU	ALE		ITG	ITO	IMS	IVL
ex24	ALU	ALE		ITG	ITO	IMS	IVL
ex25	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex26	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex27	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex28	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex29	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex30	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex31	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex32	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex33	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO
ex34	ISH	IFG	ICP		OOX	ALI		OLA	OMO	IMO

 

[Kaper]

Unpivoting macro proposition:
assuming the sheet is active and data starts in A1:

Sub test()
Dim lr As Long, lc As Long, i As Long, j As Long, counter As Long
Dim inarr As Variant, outtarr() As Variant
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range(Cells(1, "B"), Cells(lr, Columns.Count))
  On Error Resume Next
    lc = .Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
      SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
  On Error GoTo 0
End With
inarr = Range(Cells(1, "A"), Cells(lr, lc)).Value
ReDim outarr(1 To 2, 1 To 1)
For i = 1 To lr
  For j = 2 To lc
    If Len(inarr(i, j)) > 0 Then
      counter = counter + 1
      ReDim Preserve outarr(1 To 2, 1 To counter)
      outarr(1, counter) = inarr(i, 1)
      outarr(2, counter) = inarr(i, j)
    End If
Next j, i
Cells(1, lc + 2).Resize(counter, 2) = Application.Transpose(outarr)
End Sub

 

[Kaper]

But (for many people - obviously) the easiest way to achieve such result is probably by using Power Query (Get and transform data).
I did it as separate workbook, but steps are almost the same for doing it in the same workbook:
1) start with Data->Get&transform->From file->Excel workbook (in case of dayta in the same wb - from table/range) and select source
2) click transform
3) remove 2 automatically created steps: promote headers and change type
4) (having Column 1 selected) from Transform Card use Unpivot other columns
5) remove unneeded Attribute column
6) from mail close and load to (or close and load).

That's it. And with new file you just change input data. The m-code which was created during clicking points 1-6 above) is as simple as:

let
    Source = Excel.Workbook(File.Contents("C:\Users\Kaper\test\test1.xlsm"), null, true),
    Sheet1_Sheet = Source{[Item="Sheet1",Kind="Sheet"]}[Data],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Sheet1_Sheet, {"Column1"}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Other Columns",{"Attribute"})
in
    #"Removed Columns"

so much simpler than VBA

 

[Kaper]

And yet another idea, as you are using Microsoft 365 - a formula:

=LET(src,A1:AF33,first,TAKE(src,,1),cols,COLUMNS(src)-1,notfi,HSTACK(REDUCE(first,SEQUENCE(cols-1),LAMBDA(a,b,VSTACK(a,first))),TOCOL(DROP(src,,1),,TRUE)),FILTER(notfi,TAKE(notfi,,-1)<>""))

 

[doriannjeshi]

Hi Kaper, thank you for the exhaustive reply.
In order to run it automatically which solution is more appropriate ?

 

[djclements]

Another basic "unpivot" formula for MS365 is the TOCOL-IFS method:

by row:

=LET(test,B1:AF34<>"",HSTACK(TOCOL(IFS(test,A1:A34),2),TOCOL(IFS(test,B1:AF34),2)))

by column:

=LET(test,B1:AF34<>"",HSTACK(TOCOL(IFS(test,A1:A34),2,1),TOCOL(IFS(test,B1:AF34),2,1)))

Adjust the range references as needed.

 

[Kaper]

As for automatisation - is data in excel file? text file? - does the name of the file change? how large is original dataset, how often does it change, and some other questions ...
Probably most automatic is formula approach. Once data is entered in workbook, output is recalculated (if the manual calculation mode is not swithched on)