Combine Dates with one UniqueID

[GreyFox8991]

Greetings Excel community,

I have a set of ID's and dates which are associated to these ID's. The ID's are repeated but there are numerous dates associated with its respective ID. What I am attempting to accomplish is combining all the dates associated with the specific ID. For example, ID 123 has four dates associated with it. I am trying to create a formula or a solution that will associate all the dates with the respective ID. One column will have the Unique ID, and the other will contain all the dates associated with that specific ID number. I am including a current state and End State mini sheet for reference if needed. Any insight would be appreciated:

Book1
	A	B
1	CurrentState
2	ID	Date
3	123	01/01/2023,01/02/2023
4	123	01/03/2023,01/04/2023
5	456	02/02/2023,02/01/2023,04/01/2023
6	456	04/05/2023,06/06/2023,07/07/2023
7	456	04/06/2023,06/07/2023,08/09/2023,07/08/2023
8	789	01/01/2023,05/01/2023
9	789	02/01/2023,02/02/2023
10	789	03/01/2023,01/04/2023,01/05/2023,01/06/2023
11	789	01/07/2023,01/08/2023,01/09/2023,01/10/2023
12
13
14
15
16	EndState
17	123	01/01/2023,01/02/2023,01/03/2023,01/04/2023
18	456	02/02/2023,02/01/2023,04/01/2023,04/05/2023,06/06/2023,07/07/2023
19	789	01/01/2023,05/01/2023,02/01/2023,02/02/2023,03/01/2023,01/04/2023,01/05/2023,01/06/2023,01/07/2023,01/08/2023,01/09/2023,01/10/2023
Sheet1

 

[kevin9999]

Here's one option. Assumes your data is in columns A & B and the "EndState" doesn't exist before running the code.

Sub Concat_Dates()
    Dim R As Long, LRow As Long, Data
    LRow = Cells(Rows.Count, "A").End(xlUp).Row
    Data = Sheets("Sheet1").Range("A2:B" & LRow)
    With CreateObject("Scripting.Dictionary")
        For R = 1 To UBound(Data)
            .Item(Data(R, 1)) = .Item(Data(R, 1)) & " , " & Data(R, 2)
            If Left(.Item(Data(R, 1)), 3) = " , " Then .Item(Data(R, 1)) = Mid(.Item(Data(R, 1)), 4)
        Next
        Sheets("Sheet1").Range("A" & LRow + 3).Resize(.Count) = Application.Transpose(.keys)
        Sheets("Sheet1").Range("B" & LRow + 3).Resize(.Count) = Application.Transpose(.Items)
    End With
End Sub

Before:

Book1
	A	B
1	CurrentState
2	ID	Date
3	123	01/01/2023,01/02/2023
4	123	01/03/2023,01/04/2023
5	456	02/02/2023,02/01/2023,04/01/2023
6	456	04/05/2023,06/06/2023,07/07/2023
7	456	04/06/2023,06/07/2023,08/09/2023,07/08/2023
8	789	01/01/2023,05/01/2023
9	789	02/01/2023,02/02/2023
10	789	03/01/2023,01/04/2023,01/05/2023,01/06/2023
11	789	01/07/2023,01/08/2023,01/09/2023,01/10/2023
12
13
14
15
16
17
18
Sheet1

After:

Book1
	A	B
1	CurrentState
2	ID	Date
3	123	01/01/2023,01/02/2023
4	123	01/03/2023,01/04/2023
5	456	02/02/2023,02/01/2023,04/01/2023
6	456	04/05/2023,06/06/2023,07/07/2023
7	456	04/06/2023,06/07/2023,08/09/2023,07/08/2023
8	789	01/01/2023,05/01/2023
9	789	02/01/2023,02/02/2023
10	789	03/01/2023,01/04/2023,01/05/2023,01/06/2023
11	789	01/07/2023,01/08/2023,01/09/2023,01/10/2023
12
13
14	ID	Date
15	123	01/01/2023,01/02/2023 , 01/03/2023,01/04/2023
16	456	02/02/2023,02/01/2023,04/01/2023 , 04/05/2023,06/06/2023,07/07/2023 , 04/06/2023,06/07/2023,08/09/2023,07/08/2023
17	789	01/01/2023,05/01/2023 , 02/01/2023,02/02/2023 , 03/01/2023,01/04/2023,01/05/2023,01/06/2023 , 01/07/2023,01/08/2023,01/09/2023,01/10/2023
18
Sheet1