Transform a List with associated category to columns of category

[macrophil]

ok I'm not sure how to describe this but an image is worth a 1000s word.

This is what I'd like to automate:

https://ibb.co/cbm6ke


hopefully the image link will show what I'm looking to do, it's the first time I do this image link

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Trans()
   Dim Cl As Range
   Dim i As Long
   Dim Ky As Variant, splt As Variant
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, -1).Value
         Else
            .Item(Cl.Value) = .Item(Cl.Value) & "," & Cl.Offset(, -1).Value
         End If
      Next Cl
      i = 6
      For Each Ky In .keys
         i = i + 1
         splt = Split(.Item(Ky), ",")
         Cells(1, i).Value = Ky
         Cells(2, i).Resize(UBound(splt) + 1).Value = Application.Transpose(splt)
      Next Ky
   End With
End Sub

 

[macrophil]

my goshh thank for the quick response. You definitly seem like a pro in excel.

I guess I'll have to look up a bit on how to paste your code in vba, I read somwhere I would hve to paste in "modules" in the Vba scripter. And I'll try it up tonight maybe.

Again, thanks, it seems so easy for you. I'll need some time to figure it out but I'll post back with test result.

 

[sandy666]

How about PowerQuery

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Product number", Int64.Type}, {"type", type text}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"type"}, {{"Count", each _, type table}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Product number", each Table.Column([Count],"Product number")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Product number", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
    #"Removed Columns" = Table.RemoveColumns(#"Extracted Values",{"Count"}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Removed Columns", "Product number", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Product number.1", "Product number.2", "Product number.3", "Product number.4", "Product number.5"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Product number.1", Int64.Type}, {"Product number.2", Int64.Type}, {"Product number.3", Int64.Type}, {"Product number.4", Int64.Type}, {"Product number.5", Int64.Type}}),
    #"Transposed Table" = Table.Transpose(#"Changed Type1"),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table", [PromoteAllScalars=true]),
    #"Changed Type2" = Table.TransformColumnTypes(#"Promoted Headers",{{"shoe", Int64.Type}, {"t-shirt", Int64.Type}, {"pants", Int64.Type}, {"gloves", Int64.Type}})
in
    #"Changed Type2"

Product number	type		shoe	t-shirt	pants	gloves
182432​	shoe		182432​	159663​	124458​	361181​
159663​	t-shirt		287599​	879713​	254879​	278413​
124458​	pants		158423​		345982​
287599​	shoe				123456​
361181​	gloves				957843​
879713​	t-shirt
158423​	shoe
254879​	pants
345982​	pants
123456​	pants
957843​	pants
278413​	gloves

 

[macrophil]

It works, Thanks a lot. Would you by any chance know if I can output it into a new sheet ?

 

[sandy666]

to whom you are talkin' ?

 

[macrophil]

to fluff. But thanks for sharing your solution. I don't know anything about powerquery, I will have to look it up. As for fluff's code, I copied and pasted it in VBA module and it seams to work flawlessly without even selecting the cells. I did change the i variable to see that it moves the first outputed column to the right. but other then that it does what I've been trying to figure out for the last week.

 

[sandy666]

Ok, no problem, but sometimes it's a good idea to use the username you're talking to especially when the thread has more than two people
PowerQuery? for a good start: Getting Started with Power Query (Get & Transform)
Have a nice day

 

[Fluff]

Yo output to a new sheet try

Sub Trans()
   Dim Cl As Range
   Dim i As Long
   Dim Ky As Variant, splt As Variant
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, -1).Value
         Else
            .Item(Cl.Value) = .Item(Cl.Value) & "," & Cl.Offset(, -1).Value
         End If
      Next Cl
      For Each Ky In .keys
         i = i + 1
         splt = Split(.Item(Ky), ",")
         Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Cells(1, i).Value = Ky
         Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Cells(2, i).Resize(UBound(splt) + 1).Value = Application.Transpose(splt)
      Next Ky
   End With
End Sub

Change value in red to suit

 

[macrophil]

Fluff, this works flawlessly, this is just magic! thanks again