Combine matches

[liampog]

Hi

On Sheet1, I have the following columns of data

	A	B	C	D
1	DATE	NUMBER	NAME	TYPE(S)
2	01/01/2019	123	J Bloggs	A,B
3	01/01/2019	456	D Smith	A
4	01/01/2019	789	P Jones	B,C
5	02/01/2019	123	J Bloggs	B
6	02/01/2019	789	P Jones	D
7	03/01/2019	456	D Smith	A,B,C
8	03/01/2019	789	P Jones	C
9	03/01/2019	000	J Doe	A
10	03/01/2019	123	J Bloggs	A,C
11	04/01/2019	456	D Smith	A
12	05/01/2019	123	J Bloggs	A,B
13	05/01/2019	456	D Smith	B,D

<tbody>
</tbody>

On Sheet2, I have the desired output shown below.

I have already created VBA that copies the B column from Sheet1 to Sheet2 and then removes duplicates to create a unique list of numbers. I then have a VLOOKUP set up to capture the name associated with the number. My problem is Column C on Sheet2.

I want to combine all of the Types from each customer, removing any duplicate entries.

The desired output is below and you can cross-reference this to Sheet1

	A	B	C
1	NUMBER	NAME	TYPE(S)
2	123	J Bloggs	A,B,C
3	456	D Smith	A,B,C,D
4	789	P Jones	B,C,D
5	000	J Doe	A

<tbody>
</tbody>

Is there a formula that can achieve this? I'm sure there probably is but my knowledge of Excel formulas isn't amazing.

Thanks

 

[offthelip]

looks like an ideal example where using a dictionary of dictionaries would solve your problem.

 

[sandy666]

you can try Power Query aka Get&Transform

DATE	NUMBER	NAME	TYPE(S)		NUMBER	NAME	TYPE
01/01/2019​	123​	J Bloggs	A,B		123	J Bloggs	A,B,C
01/01/2019​	456​	D Smith	A		456	D Smith	A,B,C,D
01/01/2019​	789​	P Jones	B,C		789	P Jones	B,C,D
02/01/2019​	123​	J Bloggs	B		000	J Doe	A
02/01/2019​	789​	P Jones	D
03/01/2019​	456​	D Smith	A,B,C
03/01/2019​	789​	P Jones	C
03/01/2019​	000	J Doe	A
03/01/2019​	123​	J Bloggs	A,C
04/01/2019​	456​	D Smith	A
05/01/2019​	123​	J Bloggs	A,B
05/01/2019​	456​	D Smith	B,D

[SIZE=1]// Table1
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Type = Table.TransformColumnTypes(Source,{{"DATE", type datetime}, {"NUMBER", type text}, {"NAME", type text}, {"TYPE(S)", type text}}),
    ROC = Table.SelectColumns(Type,{"NUMBER", "NAME", "TYPE(S)"}),
    Split = Table.ExpandListColumn(Table.TransformColumns(ROC, {{"TYPE(S)", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "TYPE(S)"),
    Group = Table.Group(Split, {"NUMBER", "NAME"}, {{"Count", each _, type table}}),
    List = Table.AddColumn(Group, "TYPE", each List.Distinct(Table.Column([Count],"TYPE(S)"))),
    Extract = Table.TransformColumns(List, {"TYPE", each Text.Combine(List.Transform(_, Text.From), ","), type text})
in
    Extract[/SIZE]

 

[Fluff]

How about

Sub liampog()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant
   Dim i As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then
         Dic.Add Cl.Value, Array(Cl.Offset(, 1).Value, CreateObject("system.collections.arraylist"))
      End If
      Ky = Split(Cl.Offset(, 2).Value, ",")
      For i = 0 To UBound(Ky)
         With Dic(Cl.Value)(1)
            If Not .contains(CStr(Ky(i))) Then .Add CStr(Ky(i))
         End With
      Next i
   Next Cl
   i = 1
   For Each Ky In Dic.Keys
      i = i + 1
      Sheets("sheet2").Range("A" & i).Resize(, 3).Value = Array(Ky, Dic(Ky)(0), Join(Dic(Ky)(1).toarray, ","))
   Next Ky
End Sub

 

[liampog]

Hi

I've just realised I asked this question before. Sorry!

Thanks for your answers. I'll have a look at them. The last answer looks interesting. I assume this is a "Dictionary of Dictionaries" mentioned in the first answer, which I've never heard of before!

Thanks
Liam

 

[Fluff]

I assume this is a "Dictionary of Dictionaries" mentioned in the first answer,

No it's not, but similar
Although I forgot a bit, use

Sub liampog()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant
   Dim i As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
      If Not Dic.Exists(Cl.Value) Then
         Dic.Add Cl.Value, Array(Cl.Offset(, 1).Value, CreateObject("system.collections.arraylist"))
      End If
      Ky = Split(Cl.Offset(, 2).Value, ",")
      For i = 0 To UBound(Ky)
         With Dic(Cl.Value)(1)
            If Not .contains(CStr(Ky(i))) Then .Add CStr(Ky(i))
         End With
      Next i
   Next Cl
   i = 1
   For Each Ky In Dic.Keys
      i = i + 1
      Dic(Ky)(1).Sort
      Sheets("sheet2").Range("A" & i).Resize(, 3).Value = Array(Ky, Dic(Ky)(0), Join(Dic(Ky)(1).toarray, ","))
   Next Ky
End Sub

 

[liampog]

From my OP:

Is there a formula that can achieve this?

Whilst this VBA code works perfectly, what I really wanted is some kind of lookup formula that achieves the same thing so that if the data in the Type column is changed on Sheet1, it reflects in the output automatically on Sheet2 without the need for any VBA code firing.

If there is no formula, or combination of formulas, that achieves the desired outcome, the VBA code you've detailed will be a workaround that I can put in perhaps run if with a Worksheet_Change event on any cells in the Type column on Sheet1.

Thanks for your help,
Liam

 

[liampog]

I also forgot to say that I only need formulas and/or VBA code to help me with Column C on Sheet2 (the Types column). The number and name columns are already sorted.

Just a way to lookup and combine unique values from Types.

Thanks in advance,
Liam

 

[Fluff]

Formulae are not my strong point, so not sure if it can be done that way, but if it is possible it would probably be a very complex formula.
However you could use this UDF

Function liampog(Rng As Range, Crit As String) As String
   Dim Cl As Range
   Dim Lst As Object
   Dim Sp As Variant
   Dim i As Long
   
   Set Lst = CreateObject("system.collections.arraylist")
   For Each Cl In Rng
      If Cl.Value = Crit Then
         Sp = Split(Cl.Offset(, 2), ",")
         For i = 0 To UBound(Sp)
            If Not Lst.contains(CStr(Sp(i))) Then Lst.Add CStr(Sp(i))
         Next i
      End If
   Next Cl
   Lst.Sort
   liampog = Join(Lst.toarray, ",")
End Function

Used like
=liampog(Sheet1!$B$2:$B$13,A1)

 

[liampog]

Hi Fluff

Thanks for the reply.

Whilst this works perfectly, it processes extremely slowly, to the point where Excel goes into Not Responding mode until it's finished, and this is just for ONE formula.

The next part of my VBA code will be autofilling this formula down as far as there is data in the first column. This could potentially be several hundred rows of data.

Do you have any other suggestions? Or should it be taking this long?

Thanks
Liam