Using formula or macro to find non repeatable combinations

[vbaNumpty]

I am trying to get color combinations for various product types. I have the following two columns:

Product	Colour
Product A	Blue
Product A	Yellow
Product A	Pink
Product A	Green
Product A	Orange
Product B	Yellow
Product B	Green
Product B	Blue
Product B	Pink
Product C	Blue
Product C	Green
Product C	Pink

and so on.

I am looking to get a new table with the output being the following:

Product - Color 1 & Color 2

I would like for these combinations to be non repeatable. The output would look like the following:

Product	Colour
Product A	Blue & Yellow
Product A	Blue & Pink
Product A	Blue & Green
Product A	Blue & Orange
Product A	Yellow & Pink
Product A	Yellow & Green
Product A	Yellow & Orange
...	...

Etc. Following it up with product B and C and so on.

How can I achieve this? I have tried some concatenating formulae that have 100 if statements, but I am not getting the desired results.

 

[lrobbo314]

You can use Power Query.

Book2
	A	B	C	D	E
1	Product	Colour		Product	Custom
2	Product A	Blue		Product A	Blue & Yellow
3	Product A	Yellow		Product A	Blue & Pink
4	Product A	Pink		Product A	Blue & Green
5	Product A	Green		Product A	Blue & Orange
6	Product A	Orange		Product A	Pink & Yellow
7	Product B	Yellow		Product A	Green & Yellow
8	Product B	Green		Product A	Orange & Yellow
9	Product B	Blue		Product A	Green & Pink
10	Product B	Pink		Product A	Orange & Pink
11	Product C	Blue		Product A	Green & Orange
12	Product C	Green		Product B	Green & Yellow
13	Product C	Pink		Product B	Blue & Yellow
14				Product B	Pink & Yellow
15				Product B	Blue & Green
16				Product B	Green & Pink
17				Product B	Blue & Pink
18				Product C	Blue & Green
19				Product C	Blue & Pink
20				Product C	Green & Pink
X

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Link = Table.AddColumn(Source, "Link", each 1),
    Merge = Table.NestedJoin(Link, {"Link"}, Link, {"Link"}, "Added Custom", JoinKind.LeftOuter),
    Expand = Table.ExpandTableColumn(Merge, "Added Custom", {"Product", "Colour"}, {"Product.1", "Colour.1"}),
    SR = Table.SelectRows(Expand, each [Colour] <> [Colour.1] and [Product] = [Product.1]),
    Combo = Table.AddColumn(SR, "Custom", each if [Colour] < [Colour.1] then [Colour] & " & " & [Colour.1] else [Colour.1] & " & " & [Colour]),
    RC = Table.RemoveColumns(Combo,{"Colour", "Link", "Product.1", "Colour.1"}),
    RD = Table.Distinct(RC)
in
    RD

 

[lrobbo314]

And a VBA version if you prefer.

Book2
	A	B	C	D	E
1	Product	Colour		Product	COMBOS
2	Product A	Blue		Product A	Blue & Yellow
3	Product A	Yellow		Product A	Blue & Pink
4	Product A	Pink		Product A	Blue & Green
5	Product A	Green		Product A	Blue & Orange
6	Product A	Orange		Product A	Yellow & Pink
7	Product B	Yellow		Product A	Yellow & Green
8	Product B	Green		Product A	Yellow & Orange
9	Product B	Blue		Product A	Pink & Green
10	Product B	Pink		Product A	Pink & Orange
11	Product C	Blue		Product A	Green & Orange
12	Product C	Green		Product B	Yellow & Green
13	Product C	Pink		Product B	Yellow & Blue
14				Product B	Yellow & Pink
15				Product B	Green & Blue
16				Product B	Green & Pink
17				Product B	Blue & Pink
18				Product C	Blue & Green
19				Product C	Blue & Pink
20				Product C	Green & Pink
Sheet4

Sub Main()
Dim AR() As Variant:    AR = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value2
Dim AL As Object:       Set AL = CreateObject("System.Collections.ArrayList")

COMBIX AR, 2, 1, 0, "", "", AL

With Range("D1:E1")
    .Value = Array("Product", "COMBOS")
    .Font.Bold = True
End With

With Range("D2").Resize(AL.Count)
    .Value = Application.Transpose(AL.toArray)
    .TextToColumns , DataType:=xlDelimited, SemiColon:=True
End With

End Sub

Sub COMBIX(AR() As Variant, Grp As Integer, IDX As Integer, Depth As Integer, Buffer As String, Prev As String, AL As Object)
Dim Prefix As String
Dim Product As String
Dim tmp As String

For i = IDX To UBound(AR)
    Product = AR(i, 1)
    If Buffer = vbNullString Then
        Prefix = AR(i, 2)
    Else
        If Prev = Product Then
            Prefix = Join(Array(Buffer, AR(i, 2)), " & ")
        End If
    End If
    If Depth + 1 = Grp Then
        If Prefix <> vbNullString Then
            tmp = Prev & ";" & Prefix
            If Not AL.contains(tmp) Then AL.Add tmp
        End If
    Else
        COMBIX AR, Grp, i + 1, Depth + 1, Prefix, Product, AL
    End If
Next i
End Sub

 

[vbaNumpty]

You can use Power Query.

Never knew about Power Query, thanks for opening pandoras box! Now I have to learn it ontop of VBA.. GAHH

Thanks a lot! Appreciate it.

 

[lrobbo314]

Power Query is a very cool tool and well worth the time to get into.

Glad it worked for ya.