Consolidate a list based on identical values in one column

[Juergen_Thoma]

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

[#2]

@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.

[#3]

@Juergen_Thoma 

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 Sub

[#4]

@Hans Vogelaar 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?

[#5]

@Juergen_Thoma Why bother with VBA in the first place? You already use Power Query to connect to an  SQL database with 799847 rows. Just add a few more applied steps and you're done. No need to load the entire table in an Excel either.

[#6 · Accepted solution]

@Juergen_Thoma 

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)

[#7]

@Hans Vogelaar @Riny_van_Eekelen 

Hello together,

sorry for the late response. I just wanted to say that both solutions worked fine for me, thanks a lot for your feedback. In the end changing the query was the more efficient way, bacause I didn't have to load the entire table in Excel.

Best regards

Jürgen