Converting multiple rows to single rows

Dim iCTR As Integer
    For iCTR = 1 To 10
        Select Case Split(Range("A" & iCTR).Value, ",")(0)
            Case "User1"
                Range("B1").Value = Range("B1").Value & ", " & Split(Range("A" & iCTR).Value, ",")(1)
            Case "User2"
                Range("B2").Value = Range("B2").Value & ", " & Split(Range("A" & iCTR).Value, ",")(1)
            Case "User3"
                Range("B3").Value = Range("B3").Value & ", " & Split(Range("A" & iCTR).Value, ",")(1)
        End Select
    Next iCTR

Dim cl As Range, oNm, Rng As Range, Mch, Ray
Dim Nray(), c As Integer, Rw As Integer
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Ray = Rng
c = 0
For Each cl In Rng
    Rw = cl.Row
        For Mch = (UBound(Ray) + 1) To 1 Step -1
            If Range("B" & Mch).Row >= cl.Row _
                And cl.Offset(, -1).Value = Range _
                ("A" & Mch).Value Then
                ReDim Preserve Nray(c)
                Nray(c) = Format(Range("B" & Mch).Value, "dd/mm/yy")
                c = c + 1
                If Rw < Mch Then Range("B" & Mch).EntireRow.Delete
            End If
       Next Mch
       cl.Resize(, c).Value = Nray
    
Erase Nray
c = 0
Next cl

Sub kTest()
Dim a, k(), q(), i As Long, n As Long, lCol As Long
a = Range("a1").CurrentRegion.Resize(, 2)
ReDim k(1 To UBound(a, 1), 1 To Columns.Count)
With CreateObject("scripting.dictionary")
    .comparemode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If Not .exists(a(i, 1)) Then
            n = n + 1
            k(n, 1) = a(i, 1): k(n, 2) = a(i, 2)
            .Add a(i, 1), Array(n, 2)
        Else
            q = .Item(a(i, 1)): q(1) = q(1) + 1
            k(q(0), q(1)) = a(i, 2)
            lCol = Application.Max(lCol, q(1))
            .Item(a(i, 1)) = q
        End If
    Next
End With
With Range("d1")
    .Resize(n, lCol).Value = k
End With
End Sub