Help Concatinating cells from a column based on duplicate rows

I have a spreadsheet with multiple columns. The first column has many duplicates. For each group of the duplicate values in first column, I want to concatenate unique values in other columns. I started on the attached file by identifying the first of each unique cells. I need help on how to fill in the concatenated values.

Blue colums are the source data, Green columns are the start of the desired output and Yellow is where I need help. I manually typed the desired output in red text for the first row as an example.

Thanks

Hi Rabid Squirrel
Welcome to the forum

Can you modify the macro?

Option Explicit
Sub test19()
    Dim a, b(), i As Long, ii As Long, n As Long
    With Worksheets("Sheet1").Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 5)
        a = .Value
    End With
    ReDim b(1 To UBound(a, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a, 1)
            If Not IsEmpty(Trim(a(i, 1))) Then
                If Not .exists(Trim(a(i, 1))) Then
                    n = n + 1
                    For ii = 1 To 5
                        b(n, ii) = Trim(a(i, ii))
                    Next
                    .Add a(i, 1), n
                Else
                    For ii = 2 To 5
                        b(.Item(Trim(a(i, 1))), ii) = b(.Item(Trim(a(i, 1))), ii) & IIf(b(.Item(Trim(a(i, 1))), ii) <> "", ", ", "") & " " & a(i, ii)
                    Next
                End If
            End If
        Next
    End With
    With Worksheets("Sheet2")
        .Range("a1").Resize(n, 5).Value = b
    End With
End Sub

Hi Rabid Squirrel
No problem, almost perfectly is not close enough

Option Explicit
Sub test19()
    Dim a, b(), i As Long, ii As Long, n As Long, temp As String, e
    With Worksheets("Sheet1").Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 5)
        a = .Value
    End With
    ReDim b(1 To UBound(a, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a, 1)
            If Not IsEmpty(Trim(a(i, 1))) Then
                If Not .exists(Trim(a(i, 1))) Then
                    n = n + 1
                    For ii = 1 To 5
                        b(n, ii) = Trim(a(i, ii))
                    Next
                    .Add Trim(a(i, 1)), n
                Else
                    For ii = 2 To 5
                        b(.Item(Trim(a(i, 1))), ii) = b(.Item(Trim(a(i, 1))), ii) & IIf(b(.Item(Trim(a(i, 1))), ii) <> "", ",", "") & " " & a(i, ii)
                    Next
                End If
            End If
        Next
        .RemoveAll
        For i = 2 To n
            For ii = 2 To 5
                For Each e In Split(b(i, ii), ",")
                    If Not .exists(Trim(e)) Then
                        temp = temp & "," & e
                        .Add Trim(e), Nothing
                    End If
                Next
                b(i, ii) = Mid$(temp, 2)
                temp = ""
                .RemoveAll
            Next
        Next
    End With
    With Worksheets("Sheet3")
        .Range("a1").Resize(n, 5).Value = b
    End With

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save

The error above is back and I can't get rid of it.

I've attached the whole workbook and I would really appreciate it if you could take a look. I'm trying to run your code to transform the data from "Step 3" into "Step 4".

I renamed the macro to BuildRCS and I don't know why it worked one time but now it gets the error and I can't figure out why.

Thank you for your help again.

Rabid Squirrel,
Possibly you will need to have the sheet with the data visible