combine data from same source in 1 cell

[chornat]

Hi,
I post some kind of the same question last week. But still has not get the final answer which I think my question may be too complicated so I post it again with simplify question.

Basically, I have data of same person in different row. How can I combine it in to one row or one cell? Thank you! ^-^

my data looks like this

Name​	Preference​
Nat​	Apple​
Nat​	Orange​
May​	Melon​
May​	Ovocado​
Jack​	Banana​
Jack​	Papaya​

I want it to look like this

Name​	Preference​
Nat​	Apple Orange​
May​	Melong Avocado​
Jack​	Banana Papaya​

 

[Ezguy4u]

Well let's get the ball rolling. Now this program will work. I know this should start the conversation going. Maybe some of the A students will weigh in and give us some more solutions.

Sub Consol()

    Dim Name As String
    Dim Pref As String
    Dim LastRow As Integer
    Dim Row1 As Integer
    
    Row1 = 2
    LastRow = Range("A1", Range("A1").End(4)).Rows.Count
    
    For i = 2 To LastRow Step 2
    
    Cells(Row1, 4) = Cells(i, 1).Value
    Cells(Row1, 5) = Cells(Row1, 2) & vbNewLine & Cells(Row1 + 1 + 1, 2)
    Row1 = Row1 + 1
    
    Next i
    
End Sub

Book1
	A	B	C	D	E
1	Name	Preference
2	Nat	Apple		Nat	Apple Melon
3	Nat	Orange		May	Orange Ovocado
4	May	Melon		Jack	Melon Banana
5	May	Ovocado
6	Jack	Banana
7	Jack	Papaya
Sheet4

 

[Toadstool]

Hi Chornat,

I can't see how to put all in the same cell but I can repeat in the same row but multiple columns:

Chornat.xlsx
	A	B	C	D	E	F	G	H	I
1	Name	Preference		Name	Preferences	2nd	3rd	4th	5th
2	Nat	Apple		Nat	Apple	Orange
3	Nat	Orange		May	Melon	Ovocado
4	May	Melon		Jack	Banana	Papaya
5	May	Ovocado
6	Jack	Banana
7	Jack	Papaya
8
9
Sheet1

Cell Formulas
Range	Formula
D2:D9	D2	=INDEX($A$2:$A$999,MATCH(0,INDEX(COUNTIF($D$1:$D1,$A$2:$A$999),),0))&""
E2:I9	E2	=IF($D2="","",IFERROR(INDEX($B$2:$B$999,AGGREGATE(15,6,ROW($B$2:$B$999)-ROW($B$1)/($A$2:$A$999=$D2),COLUMN()-COLUMN($D$1))),""))

 

[Peter_SSs]

I post some kind of the same question last week.

In future, please do not start a new thread in that circumstance. Refer to #12 of the Forum Rules and points 6 & 7 of the Guidelines.

For reference the other thread, which I have now locked, is here.

From that other thread it appears that items for one person may be repeated in the second column but you do not want them repeated in the results. If that is so, then you might try this macro.

Sub CombinePrefs()
  Dim d As Object
  Dim a As Variant, b 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)
    If Not d.exists(a(i, 1)) Then d.Add a(i, 1), CreateObject("Scripting.Dictionary")
    d(a(i, 1))(a(i, 2)) = Empty
  Next i
  ReDim b(1 To d.Count, 1 To 2)
  For i = 1 To d.Count
    b(i, 1) = d.keys()(i - 1)
    b(i, 2) = Join(d.items()(i - 1).keys(), vbLf)
  Next i
  With Range("D2:E2").Resize(d.Count)
    .Value = b
    .Columns(2).WrapText = True
    .Rows(0).Value = Array("Name", "Preferences")
  End With
End Sub

My sample data and results:

chornat.xlsm
	A	B	C	D	E
1	Name	Preference		Name	Preferences
2	Nat	Apple		Nat	Apple Orange
3	Nat	Orange		May	Melon Ovocado
4	Nat	Apple		Jack	Banana Papaya
5	May	Melon
6	May	Ovocado
7	Jack	Banana
8	Jack	Papaya
Sheet1

 

[chornat]

Hi Chornat,

I can't see how to put all in the same cell but I can repeat in the same row but multiple columns:

Chornat.xlsx
	A	B	C	D	E	F	G	H	I
1	Name	Preference		Name	Preferences	2nd	3rd	4th	5th
2	Nat	Apple		Nat	Apple	Orange
3	Nat	Orange		May	Melon	Ovocado
4	May	Melon		Jack	Banana	Papaya
5	May	Ovocado
6	Jack	Banana
7	Jack	Papaya
8
9
Sheet1

Cell Formulas
Range	Formula
D2:D9	D2	=INDEX($A$2:$A$999,MATCH(0,INDEX(COUNTIF($D$1:$D1,$A$2:$A$999),),0))&""
E2:I9	E2	=IF($D2="","",IFERROR(INDEX($B$2:$B$999,AGGREGATE(15,6,ROW($B$2:$B$999)-ROW($B$1)/($A$2:$A$999=$D2),COLUMN()-COLUMN($D$1))),""))

This also work as well. because then I can use CONCATENATE to combine F&G&H&I colume!

 

[chornat]

Well let's get the ball rolling. Now this program will work. I know this should start the conversation going. Maybe some of the A students will weigh in and give us some more solutions.

Sub Consol()

    Dim Name As String
    Dim Pref As String
    Dim LastRow As Integer
    Dim Row1 As Integer
   
    Row1 = 2
    LastRow = Range("A1", Range("A1").End(4)).Rows.Count
   
    For i = 2 To LastRow Step 2
   
    Cells(Row1, 4) = Cells(i, 1).Value
    Cells(Row1, 5) = Cells(Row1, 2) & vbNewLine & Cells(Row1 + 1 + 1, 2)
    Row1 = Row1 + 1
   
    Next i
   
End Sub

Book1
	A	B	C	D	E
1	Name	Preference
2	Nat	Apple		Nat	Apple Melon
3	Nat	Orange		May	Orange Ovocado
4	May	Melon		Jack	Melon Banana
5	May	Ovocado
6	Jack	Banana
7	Jack	Papaya
Sheet4

Thank you for getting the ball rolling ^-^

 

[chornat]

In future, please do not start a new thread in that circumstance. Refer to #12 of the Forum Rules and points 6 & 7 of the Guidelines.

For reference the other thread, which I have now locked, is here.

From that other thread it appears that items for one person may be repeated in the second column but you do not want them repeated in the results. If that is so, then you might try this macro.

Sub CombinePrefs()
  Dim d As Object
  Dim a As Variant, b 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)
    If Not d.exists(a(i, 1)) Then d.Add a(i, 1), CreateObject("Scripting.Dictionary")
    d(a(i, 1))(a(i, 2)) = Empty
  Next i
  ReDim b(1 To d.Count, 1 To 2)
  For i = 1 To d.Count
    b(i, 1) = d.keys()(i - 1)
    b(i, 2) = Join(d.items()(i - 1).keys(), vbLf)
  Next i
  With Range("D2:E2").Resize(d.Count)
    .Value = b
    .Columns(2).WrapText = True
    .Rows(0).Value = Array("Name", "Preferences")
  End With
End Sub

My sample data and results:

chornat.xlsm
	A	B	C	D	E
1	Name	Preference		Name	Preferences
2	Nat	Apple		Nat	Apple Orange
3	Nat	Orange		May	Melon Ovocado
4	Nat	Apple		Jack	Banana Papaya
5	May	Melon
6	May	Ovocado
7	Jack	Banana
8	Jack	Papaya
Sheet1

First, Apologize for not carefully reading guideline.

Second, Thank you for the solution. I think this one is covered all steps. let me try and report back ^-^