Collating values from multiple rows into one row

[emedley]

I have just two columns of data (TABLE1) that I would like to covert (using functions) as shown in TABLE2

TABLE1 Col A lists Item numbers
Col B lists the Version of each Item in A

TABLE2 lists the Item numbers just once, but the Versions are collated in one cell, separated by a | character

TABLE1			TABLE2
Item	Version		Item	All_Versions
d_40	a		d_40	a|a.00|b|
d_40	a.00		d_41	a|
d_40	b		d_42	a.00|
d_41	a		d_43	a.00|
d_42	a.00		d_44	a.00|
d_43	a.00		d_45	a|a.00|c|
d_44	a.00		d_46	a.00|c|
d_45	a		d_47	a|
d_45	a.00		d_48	a|
d_45	c		d_49	a|b|c|c.00|d|
d_46	a.00		d_50	a|b|c|d|e|
d_46	c
d_47	a
d_48	a
d_49	a
d_49	b
d_49	c
d_49	c.00
d_49	d
d_50	a
d_50	b
d_50	c
d_50	d
d_50	e

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

Please could anyone help to provide a solution?

 

[Joe4]

Try this VBA code:

Sub CreateNewList()

    Dim lr As Long
    Dim r As Long
    Dim itm As String
    Dim nxtitm As String
    Dim vers As String
    Dim newcl1 As String
    Dim newcl2 As String
    Dim nr As Long
    
'   Specify new columns to put new table in
    newcl1 = "D"
    newcl2 = "E"
    
    Application.ScreenUpdating = False
    
'   Put new column headers in
    Cells(1, newcl1) = "Item"
    Cells(1, newcl2) = "All Versions"
    
'   Find last row of data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows starting in row 2
    For r = 2 To lr
'       Get item and version values
        itm = Cells(r, "A")
        vers = vers & Cells(r, "B") & "|"
'       See if it differ the next item and write values to new line
        nxtitm = Cells(r + 1, "A")
        If itm <> nxtitm Then
            nr = Cells(Rows.Count, newcl1).End(xlUp).Row + 1
            Cells(nr, newcl1) = itm
            Cells(nr, newcl2) = vers
            vers = ""
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

It assumes that the original data is in columns A and B, with headers in row 1 and data starting on row 2.
You can change the destination columns ("D" and "E" in the code, if you like).

 

[emedley]

Hi Joe4,

Thanks for your code!

It works as long as I keep Col A in order, but that's OK for me.
The code will be very useful as I'm going through >100k rows of data

 

[Joe4]

It works as long as I keep Col A in order, but that's OK for me.

Yes, I forgot to mention that assumption.

We could add a few extra lines of code to sort the data first, to make sure that happens, if desired.

 

[Peter_SSs]

Here is another option for you to test. It doesn't require that the original table is sorted by the first column.

Sub All_Versions()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    d(a(i, 1)) = d(a(i, 1)) & a(i, 2) & "|"
  Next i
  With Range("D1:E1")
    .Value = Array("Item", "All_Versions")
    .Offset(1).Resize(d.Count).Value = Application.Transpose(Array(d.Keys, d.Items))
  End With
End Sub

 

[emedley]

Thanks again Peter, a succinct solution and an education - as usual!

 

[Peter_SSs]

Thanks again Peter, a succinct solution and an education - as usual!

You're welcome.