Splitting Dates with Unique ID

GreyFox8991

New Member
Joined
Jul 20, 2022
Messages
21
Office Version
  1. 2016
Platform
  1. Windows
Hello Excel Community,

I have a set of data organized below. Each ID has a few dates associated in the respective column. I would like the end result to be where the ID is split with the respective Dates.... For reference:

9191370|06/09/2022
9191370|07/18/2022
9191400|05/03/2022
9191400|05/05/2022
9191400|07/12/2022

The ID's can be placed in Column A and the Dates can be placed in Column B if possible... Any insight would be greatly appreciated.

Thank you

DOS Splitter.xlsm
AB
1IDDates
2919137006/09/2022,07/18/2022
3919140005/03/2022,05/05/2022,07/12/2022
4919140906/03/2022,08/03/2022,10/07/2022
5919141901/03/2022,05/03/2022,07/21/2022
6919146502/22/2022,03/02/2022,03/08/2022,03/10/2022,07/08/2022
7919146908/30/2022,09/13/2022,12/15/2022
8919147102/02/2022,03/09/2022,05/12/2022
9906928706/10/2022,06/11/2022,06/12/2022,06/16/222
10925794608/02/2022,08/03/2022
11906929108/27/2022,08/28/2022,08/29/2022
12906929504/12/2022,04/13/2022,04/14/2022,04/15/2022,04/16/2022
13906929809/22/2022,09/23/2022,09/24/2022,09/25/2022,12/27/2022
14931232506/29/2022,07/19/2022,07/28/2022
15930398210/11/2022,10/12/2022,10/13/2022,10/14/2022,10/15/2022
16930398408/29/2022,08/30/2022
17905587104/21/2022,12/13/2022,12/18/2022
Sheet1
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Give this macro a try...
VBA Code:
Sub CombineLikeIDs()
  Dim X As Long, K As Variant, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "B").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For X = 1 To UBound(Data)
      .Item(Data(X, 1)) = Trim(.Item(Data(X, 1)) & " " & Data(X, 2))
    Next
    K = .Keys
    Range("D1").Resize(UBound(K) + 1) = Application.Transpose(K)
    Range("E1").Resize(UBound(K) + 1) = Application.Transpose(.Items)
    Range("E1").Resize(UBound(K) + 1).Replace " ", ", ", xlPart
  End With
End Sub
 
Upvote 0
Hi Rick,

Thank you for your suggestion... I ran the macro but it is not splitting the ID and the respective date... it copies the same data over to columns D and E... Am i inputting something wrong perhaps? I am including a screenshot of the result if this helps.
 

Attachments

  • Macro_Attempt_1.PNG
    Macro_Attempt_1.PNG
    35.2 KB · Views: 13
Upvote 0
Sorry, my fault... I read your post as having individual rows of data that you wanted to concatenate together. Here is a macro that will do what I now see you want. This code is more verbose than needed for your data, but it is something I wrote years ago to handle more columns that you have where the delimited column could be anywhere within the data grid.
VBA Code:
Sub RedistributeData()
  Dim X As Long, LastRow As Long, A As Range, Table As Range, Data() As String
  Const Delimiter As String = ","
  Const DelimitedColumn As String = "B"
  Const TableColumns As String = "A:B"
  Const StartRow As Long = 2
  Application.ScreenUpdating = False
  Columns("B").Replace ", ", ",", xlPart
  LastRow = Columns(TableColumns).Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  For X = LastRow To StartRow Step -1
    Data = Split(Cells(X, DelimitedColumn), Delimiter)
    If UBound(Data) > 0 Then
      Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert xlShiftDown
    End If
    If Len(Cells(X, DelimitedColumn)) Then
      Cells(X, DelimitedColumn).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
    End If
  Next
  LastRow = Cells(Rows.Count, DelimitedColumn).End(xlUp).Row
  On Error Resume Next
  Set Table = Intersect(Columns(TableColumns), Rows(StartRow).Resize(LastRow - StartRow + 1))
  If Err.Number = 0 Then
    Table.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    Columns(DelimitedColumn).SpecialCells(xlFormulas).Clear
    Table.Value = Table.Value
  End If
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Hi Rick,

Thank you for providing this code as this is greatly appreciated... The code works to split dates according to its respective ID however, I am wondering if there is a way to include the Unique ID in its respective row for each DOS. The Code seems to work for a smaller dataset but upon using it for a slightly bigger dataset, the Unique ID is shown for the dates followed by what looks to be a formula value in the place of the ID... I am including an example for reference. Could the code be changed to include the respective ID's in this case?

Book6
ABCDEFGHI
1IDDatesIDDatesUnique Dates Count
2C-HF223602/08/2022C-HF223602/08/2022,02/15/2022,03/02/2022,02/15/2022,03/09/2022,03/16/2022,03/23/2022,03/28/2022,03/29/2022,04/04/2022,04/05/2022,04/11/2022,04/12/2022,04/18/2022,04/19/2022,04/25/2022,04/26/2022,04/27/2022,04/28/2022,05/02/2022,05/03/2022,05/04/2022,05/09/2022,05/10/2022,05/11/2022,05/16/2022,05/17/2022,05/18/2022,05/24/2022,05/25/2022,05/31/2022,06/01/2022,06/09/2022,06/15/2022,06/22/2022,06/29/2022,07/06/2022,07/13/2022,07/21/2022,08/04/2022,08/18/2022,09/01/2022,09/08/2022,09/15/2022,09/22/2022,09/29/2022,10/06/2022,10/13/2022,10/19/2022,10/26/2022,11/07/2022,11/09/2022,11/23/2022,11/30/2022,12/07/2022,12/14/2022,12/21/2022,12/28/202258
3=R[-1]C02/15/2022C-HF23CN01/03/2022,01/10/2022,01/17/2022,01/10/2022,01/26/2022,02/02/2022,02/08/2022,02/15/2022,02/22/2022,03/01/2022,03/09/2022,03/22/2022,03/29/2022,04/05/2022,04/13/2022,04/20/2022,04/26/2022,05/04/2022,05/11/2022,05/18/2022,05/21/2022,05/25/2022,06/01/2022,06/08/2022,06/14/2022,06/21/2022,06/27/2022,06/30/2022,07/07/2022,07/14/2022,07/18/2022,07/21/2022,07/25/2022,07/27/2022,07/28/2022,08/01/2022,08/02/2022,08/11/2022,08/15/2022,08/17/2022,08/24/2022,08/29/2022,08/31/2022,09/12/2022,09/14/2022,09/16/2022,09/19/2022,09/21/2022,09/26/2022,09/29/2022,10/03/2022,10/06/2022,10/10/2022,10/13/2022,10/17/2022,10/18/2022,10/26/2022,11/02/2022,11/09/2022,11/16/2022,11/23/2022,11/29/2022,12/06/2022,12/13/2022,12/16/2022,12/20/2022,12/27/202267
4=R[-1]C03/02/2022
5=R[-1]C02/15/2022
6=R[-1]C03/09/2022
7=R[-1]C03/16/2022
8=R[-1]C03/23/2022
9=R[-1]C03/28/2022
10=R[-1]C03/29/2022
11=R[-1]C04/04/2022
12=R[-1]C04/05/2022
13=R[-1]C04/11/2022
14=R[-1]C04/12/2022
15=R[-1]C04/18/2022
16=R[-1]C04/19/2022
17=R[-1]C04/25/2022
18=R[-1]C04/26/2022
19=R[-1]C04/27/2022
20=R[-1]C04/28/2022
21=R[-1]C05/02/2022
22=R[-1]C05/03/2022
23=R[-1]C05/04/2022
24=R[-1]C05/09/2022
25=R[-1]C05/10/2022
26=R[-1]C05/11/2022
27=R[-1]C05/16/2022
28=R[-1]C05/17/2022
29=R[-1]C05/18/2022
30=R[-1]C05/24/2022
31=R[-1]C05/25/2022
32=R[-1]C05/31/2022
33=R[-1]C06/01/2022
34=R[-1]C06/09/2022
35=R[-1]C06/15/2022
36=R[-1]C06/22/2022
37=R[-1]C06/29/2022
38=R[-1]C07/06/2022
39=R[-1]C07/13/2022
40=R[-1]C07/21/2022
41=R[-1]C08/04/2022
42=R[-1]C08/18/2022
43=R[-1]C09/01/2022
44=R[-1]C09/08/2022
45=R[-1]C09/15/2022
46=R[-1]C09/22/2022
47=R[-1]C09/29/2022
48=R[-1]C10/06/2022
49=R[-1]C10/13/2022
50=R[-1]C10/19/2022
51=R[-1]C10/26/2022
52=R[-1]C11/07/2022
53=R[-1]C11/09/2022
54=R[-1]C11/23/2022
55=R[-1]C11/30/2022
56=R[-1]C12/07/2022
57=R[-1]C12/14/2022
58=R[-1]C12/21/2022
59=R[-1]C12/28/2022
60C-HF23CN01/03/2022
61=R[-1]C01/10/2022
62=R[-1]C01/17/2022
63=R[-1]C01/10/2022
64=R[-1]C01/26/2022
65=R[-1]C02/02/2022
66=R[-1]C02/08/2022
67=R[-1]C02/15/2022
68=R[-1]C02/22/2022
69=R[-1]C03/01/2022
70=R[-1]C03/09/2022
71=R[-1]C03/22/2022
72=R[-1]C03/29/2022
73=R[-1]C04/05/2022
74=R[-1]C04/13/2022
75=R[-1]C04/20/2022
76=R[-1]C04/26/2022
77=R[-1]C05/04/2022
78=R[-1]C05/11/2022
79=R[-1]C05/18/2022
80=R[-1]C05/21/2022
81=R[-1]C05/25/2022
82=R[-1]C06/01/2022
83=R[-1]C06/08/2022
84=R[-1]C06/14/2022
85=R[-1]C06/21/2022
86=R[-1]C06/27/2022
87=R[-1]C06/30/2022
88=R[-1]C07/07/2022
89=R[-1]C07/14/2022
90=R[-1]C07/18/2022
91=R[-1]C07/21/2022
92=R[-1]C07/25/2022
93=R[-1]C07/27/2022
94=R[-1]C07/28/2022
95=R[-1]C08/01/2022
96=R[-1]C08/02/2022
97=R[-1]C08/11/2022
98=R[-1]C08/15/2022
99=R[-1]C08/17/2022
100=R[-1]C08/24/2022
101=R[-1]C08/29/2022
102=R[-1]C08/31/2022
103=R[-1]C09/12/2022
104=R[-1]C09/14/2022
105=R[-1]C09/16/2022
106=R[-1]C09/19/2022
107=R[-1]C09/21/2022
108=R[-1]C09/26/2022
109=R[-1]C09/29/2022
110=R[-1]C10/03/2022
111=R[-1]C10/06/2022
112=R[-1]C10/10/2022
113=R[-1]C10/13/2022
114=R[-1]C10/17/2022
115=R[-1]C10/18/2022
116=R[-1]C10/26/2022
117=R[-1]C11/02/2022
118=R[-1]C11/09/2022
119=R[-1]C11/16/2022
120=R[-1]C11/23/2022
121=R[-1]C11/29/2022
122=R[-1]C12/06/2022
123=R[-1]C12/13/2022
124=R[-1]C12/16/2022
125=R[-1]C12/20/2022
126=R[-1]C12/27/2022
Sheet1
 
Upvote 0
@GreyFox8991
Another option:
VBA Code:
Sub GreyFox8991()

Dim i As Long, j As Long, k As Long, n As Long
Dim va, vb

va = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
ReDim vb(1 To UBound(va, 1), 1 To 2)
For i = 2 To UBound(va, 1)
 j = i
    Do
        i = i + 1
        If i > UBound(va, 1) Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
    
        i = i - 1
        k = k + 1
        vb(k, 1) = va(i, 1)
        For n = j To i
            vb(k, 2) = vb(k, 2) & "," & va(n, 2)
        Next
        vb(k, 2) = Mid(vb(k, 2), 2)
Next

Range("D2").Resize(k, 2) = vb
End Sub

Example:
Result in col D:E
Book1
ABCDE
1
2919137006/09/2022919137006/09/2022,07/18/2022
3919137007/18/2022919140005/03/2022,05/05/2022,07/12/2022
4919140005/03/2022
5919140005/05/2022
6919140007/12/2022
7
Sheet4
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top