concat values and count values for each specific id

Hello forum,

I have this long list of ID and zip code. What I need is to get for each ID the zip codes and how many in total.
On the attached file there is a sample how the result should be ...if possible. This list change often and to manually fix this is not an option...

Thanks

Try

Sub test()
    Dim a, i As Long, n As Long
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1: .Item(a(i, 1)) = n
                a(n, 1) = a(i, 1): a(n, 2) = a(i, 2)
            Else
                a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) & ", " & a(i, 2)
            End If
        Next
    End With
    Sheets.Add.Cells(1).Resize(n, 2).Value = a
End Sub

That was quick , thanks it did work fine except I did not get the count values of all zip codes

Ahh, missed it.

Sub test()
    Dim a, i As Long, n As Long
    a = Sheets("sheet1").Cells(1).CurrentRegion.Resize(, 3).Value
    a(1, 3) = "Count": n = 1
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1: .Item(a(i, 1)) = n
                a(n, 1) = a(i, 1): a(n, 2) = a(i, 2): a(n, 3) = 1
            Else
                a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) & ", " & a(i, 2)
                a(.Item(a(i, 1)), 3) = a(.Item(a(i, 1)), 3) + 1
            End If
        Next
    End With
    Sheets.Add.Cells(1).Resize(n, 3).Value = a
End Sub

Excellent!

Exactly what I needed
Humble thank you

You are welcome.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.