Forum Discussion

Copper Contributor

May 17, 2021

Solved

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

Category_Links.xlsx31 KB

excel

HansVogelaar

May 17, 2021

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)

Juergen_Thoma

Copper Contributor

May 17, 2021

HansVogelaar 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?

HansVogelaar

MVP

May 17, 2021

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)

Juergen_Thoma
Copper Contributor
May 25, 2021
HansVogelaar 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