Forum Discussion
Consolidate a list based on identical values in one column
Hello together,
I got a some kind of a specific issue. I got an Excel file with 2 columns, skus in the first column and all their categories in the second. There are multiple links for every sku and all of them are in their own row. Unfortunately I'm not able to import the file with this layout.
What I need is to transform the table to have only one row for each sku and all category links in the columns after. I tried the consolidate function, but the only result is that I got the number of category links for every sku but not the values itself.
To give you a better understanding I prepared a small example and attached it to my post. In the sheet "Current List" you can find the current layout of the list (the original has 800.000 rows) and in the sheet "Result" you find the result I need to achieve. This has been done manually, but it's impossible for the whole file.
If this result is impossible to achieve, it is also fine if all category values are placed in one cell comma or semicolon separated.
I hope you can help me here, because I don't have any idea how to do this automatically.
Best regards
Jürgen
Like this:
Sub Transform() Dim wshS As Worksheet Dim wshT As Worksheet Dim s As Long Dim m As Long Dim t As Long Dim c As Long Application.ScreenUpdating = False Set wshS = Worksheets("Current List") Set wshT = Worksheets("Result") wshT.Range("A2:A" & wshT.Rows.Count).EntireRow.Clear m = wshS.Range("A" & wshS.Rows.Count).End(xlUp).Row t = 1 For s = 2 To m If wshS.Cells(s, 1).Value <> wshS.Cells(s - 1, 1).Value Then t = t + 1 wshT.Cells(t, 1).EntireRow.NumberFormat = "@" wshT.Cells(t, 1).Value = wshS.Cells(s, 1).Value c = 1 End If c = c + 1 wshT.Cells(t, c).Value = wshS.Cells(s, 2).Value Next s Application.ScreenUpdating = True End Sub(But PowerQuery might well be better)
6 Replies
Here is a macro you can run:
Sub Transform() Dim wshS As Worksheet Dim wshT As Worksheet Dim s As Long Dim m As Long Dim t As Long Dim c As Long Application.ScreenUpdating = False Set wshS = Worksheets("Current List") Set wshT = Worksheets("Result") wshT.Range("A2:A" & wshT.Rows.Count).EntireRow.Clear m = wshS.Range("A" & wshS.Rows.Count).End(xlUp).Row t = 1 For s = 2 To m If wshS.Cells(s, 1).Value <> wshS.Cells(s - 1, 1).Value Then t = t + 1 wshT.Cells(t, 1).Value = wshS.Cells(s, 1).Value c = 1 End If c = c + 1 wshT.Cells(t, c).Value = wshS.Cells(s, 2).Value Next s Application.ScreenUpdating = True End SubHansVogelaar Thx for the macro, it works fine with the exception, that leading zeros in the values will be removed, e.g. 0000366 in the "Current List" is 366 in the "Result" table. I couldn't solve this with cell formatting, maybe it must be part of the macro?
Like this:
Sub Transform() Dim wshS As Worksheet Dim wshT As Worksheet Dim s As Long Dim m As Long Dim t As Long Dim c As Long Application.ScreenUpdating = False Set wshS = Worksheets("Current List") Set wshT = Worksheets("Result") wshT.Range("A2:A" & wshT.Rows.Count).EntireRow.Clear m = wshS.Range("A" & wshS.Rows.Count).End(xlUp).Row t = 1 For s = 2 To m If wshS.Cells(s, 1).Value <> wshS.Cells(s - 1, 1).Value Then t = t + 1 wshT.Cells(t, 1).EntireRow.NumberFormat = "@" wshT.Cells(t, 1).Value = wshS.Cells(s, 1).Value c = 1 End If c = c + 1 wshT.Cells(t, c).Value = wshS.Cells(s, 2).Value Next s Application.ScreenUpdating = True End Sub(But PowerQuery might well be better)
Juergen_Thoma Added a query (connecting to a copy of the "Current List") to your file producing the desired results. See if you can get it to work on your real data.
