Consolidate a list based on identical values in one column

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)