Add multiple data for same name into cell next to it

[Nick70]

Hi,

I have fruit names in column B which have a related country of origin in column C.

Fruit names can be repeated (eg. have duplicates or more) and country of origin could be different (e.g Strawberries can have Spain but another time they can have UK as country of origin).

I would like to have a macro that adds data for each fruit name into relative cells in column D (see example below).

Book1
	A	B	C	D	E	F
1
2
3		Fruit Names	Contry of origin	Total Countries of origin
4		strawberries	Spain	Spain UK
5		apples	France	France Italy
6		pears	Spain	Spain Italy
7		figs	Turkey	Turkey Spain
8		cherries	UK	UK Italy
9		orange	Italy	Italy Spain
10		plums	France	France UK
11		grapes	Spain	Spain South Africa
12		apples	Italy	France Italy
13		pears	Italy	Spain Italy
14		figs	Spain	Spain
15		cherries	Italy	UK Italy
16		orange	Spain	Italy Spain
17		plums	UK	France UK
18		grapes	South Africa	Spain South Africa
19		strawberries	UK	Spain UK
20
21
22
23
Sheet1

How would I do that?

Thanks!
N.

 

[lrobbo314]

Something like this.

Book1
	B	C	D	E	F	G
3	Fruit Names	Contry of origin			Fruit	Country
4	strawberries	Spain			strawberries	Spain UK
5	apples	France			apples	France Italy
6	pears	Spain			pears	Spain Italy
7	figs	Turkey			figs	Turkey Spain
8	cherries	UK			cherries	UK Italy
9	orange	Italy			orange	Italy Spain
10	plums	France			plums	France UK
11	grapes	Spain			grapes	Spain South Africa
12	apples	Italy
13	pears	Italy
14	figs	Spain
15	cherries	Italy
16	orange	Spain
17	plums	UK
18	grapes	South Africa
19	strawberries	UK
Sheet1

Sub combo()
Dim AR() As Variant: AR = Range("B4:C" & Range("B" & Rows.Count).End(xlUp).Row).Value
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(AR)
    If Not SD.exists(AR(i, 1)) Then
        SD.Add AR(i, 1), AR(i, 2)
    Else
        SD(AR(i, 1)) = SD(AR(i, 1)) & " " & AR(i, 2)
    End If
Next i

With Range("F3:G3")
    .Value = Array("Fruit", "Country")
    .Font.Bold = True
End With

Range("G4").Resize(SD.Count, 1).Value = Application.Transpose(SD.items)
Range("F4").Resize(SD.Count, 1).Value = Application.Transpose(SD.keys)
End Sub

 

[lrobbo314]

You can also get the same results using Power Query.

Book1
	B	C	D	E	F
3	Fruit Names	Country of origin		Fruit Names	Custom
4	strawberries	Spain		strawberries	Spain UK
5	apples	France		apples	France Italy
6	pears	Spain		pears	Spain Italy
7	figs	Turkey		figs	Turkey Spain
8	cherries	UK		cherries	UK Italy
9	orange	Italy		orange	Italy Spain
10	plums	France		plums	France UK
11	grapes	Spain		grapes	Spain South Africa
12	apples	Italy
13	pears	Italy
14	figs	Spain
15	cherries	Italy
16	orange	Spain
17	plums	UK
18	grapes	South Africa
19	strawberries	UK
Sheet1

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Group = Table.Group(Source, {"Fruit Names"}, {{"Count", each _, type table}}),
    Extract = Table.AddColumn(Group, "Custom", each Text.Combine(Table.Column([Count],"Country of origin")," "))
in
    Extract

 

[lrobbo314]

The 2 options above produce a little bit different results than in your OP. This version matches the output of your op.

Book1
	E	F	G
3	Fruit Names	Country of origin	Extract
4	strawberries	Spain	Spain UK
5	apples	France	France Italy
6	pears	Spain	Spain Italy
7	figs	Turkey	Turkey Spain
8	cherries	UK	UK Italy
9	orange	Italy	Italy Spain
10	plums	France	France UK
11	grapes	Spain	Spain South Africa
12	apples	Italy	France Italy
13	pears	Italy	Spain Italy
14	figs	Spain	Turkey Spain
15	cherries	Italy	UK Italy
16	orange	Spain	Italy Spain
17	plums	UK	France UK
18	grapes	South Africa	Spain South Africa
19	strawberries	UK	Spain UK
Sheet1

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Group = Table.Group(Source, {"Fruit Names"}, {{"Values", each _, type table}}),
    Extract = Table.TransformColumns(Group ,{"Values", each Text.Combine(Table.Column(_,"Country of origin")," ")}),
    Merge = Table.NestedJoin(Source,{"Fruit Names"},Extract,{"Fruit Names"},"Extract",JoinKind.LeftOuter),
    Combine = Table.TransformColumns(Merge,{"Extract", each Text.Combine(Table.Column(_,"Values")," ")})
in
    Combine