Combining Cells based on Condition

[madhuchelliah]

Hello all, i want to combine data in B column based on data in A column. If value of A column cells are same then adjacent B column cells should be combined as one cell. please refer the example for input and expected output.
Thank you.

Book2
	A	B	C	D	E	F
1	Input				Expected Output
2	Column A	Column B			Column A	Column B
3	A1	James			A1	James Vic Nate Mike Pete Augi Don
4	A1	Vic			A1
5	A1	Nate			A1
6	A1	Mike			A1
7	A1	Pete			A1
8	A1	Augi			A1
9	A1	Don			A1
10	A2	James			A2	James Vic Nate
11	A2	Vic			A2
12	A2	Nate			A2
13	A3	Nate			A3	Nate Mike Pete Augi Don
14	A3	Mike			A3
15	A3	Pete			A3
16	A3	Augi			A3
17	A3	Don			A3
Sheet14

 

[lrobbo314]

How about this?

XLTemplate1
	A	B	C	D	E	F
1	Input				Expected Output
2	Column A	Column B			Column A	Column B
3	A1	James			A1	James Vic Nate Mike Pete Augi Don
4	A1	Vic			A1
5	A1	Nate			A1
6	A1	Mike			A1
7	A1	Pete			A1
8	A1	Augi			A1
9	A1	Don			A1
10	A2	James			A2	James Vic Nate
11	A2	Vic			A2
12	A2	Nate			A2
13	A3	Nate			A3	Nate Mike Pete Augi Don
14	A3	Mike			A3
15	A3	Pete			A3
16	A3	Augi			A3
17	A3	Don			A3
Sheet1

Cell Formulas
Range	Formula
F3:F17	F3	=IF(COUNTIF($A$3:A3,A3)=1,tj($A$3:$B$17,E3),"")

Function TJ(r As Range, k As String)
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim AR() As Variant:    AR = r.Value2

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

TJ = Join(SD.keys, " ")

End Function

 

[madhuchelliah]

How about this?

XLTemplate1
	A	B	C	D	E	F
1	Input				Expected Output
2	Column A	Column B			Column A	Column B
3	A1	James			A1	James Vic Nate Mike Pete Augi Don
4	A1	Vic			A1
5	A1	Nate			A1
6	A1	Mike			A1
7	A1	Pete			A1
8	A1	Augi			A1
9	A1	Don			A1
10	A2	James			A2	James Vic Nate
11	A2	Vic			A2
12	A2	Nate			A2
13	A3	Nate			A3	Nate Mike Pete Augi Don
14	A3	Mike			A3
15	A3	Pete			A3
16	A3	Augi			A3
17	A3	Don			A3
Sheet1

Cell Formulas
Range	Formula
F3:F17	F3	=IF(COUNTIF($A$3:A3,A3)=1,tj($A$3:$B$17,E3),"")

Function TJ(r As Range, k As String)
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim AR() As Variant:    AR = r.Value2

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

TJ = Join(SD.keys, " ")

End Function

Hey Irobbo, It is working as per the sample data. Appreciate your efforts. Is it possible to have complete VBA solution instead of formula and UDF combination. Also my range is dynamic in A and B columns. Thank you.

 

[Peter_SSs]

Is it possible to have complete VBA solution

You could try this with a copy of your workbook. I have assumed that your data actually has headings in row 1 and the data starts in row 2.

Sub Combine_Values()
  Dim a As Variant, b As Variant
  Dim i As Long
  Dim s As String
  
  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  b(1, 1) = a(1, 2)
  For i = UBound(a) To 2 Step -1
    s = a(i, 2) & " " & s
    If a(i, 1) <> a(i - 1, 1) Then
      b(i, 1) = RTrim(s)
      s = vbNullString
    End If
  Next i
  Range("B1").Resize(UBound(b)).Value = b
End Sub

 

[madhuchelliah]

You could try this with a copy of your workbook. I have assumed that your data actually has headings in row 1 and the data starts in row 2.

Sub Combine_Values()
  Dim a As Variant, b As Variant
  Dim i As Long
  Dim s As String
 
  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  b(1, 1) = a(1, 2)
  For i = UBound(a) To 2 Step -1
    s = a(i, 2) & " " & s
    If a(i, 1) <> a(i - 1, 1) Then
      b(i, 1) = RTrim(s)
      s = vbNullString
    End If
  Next i
  Range("B1").Resize(UBound(b)).Value = b
End Sub

Hello Peter, it is working as expected. Thank you.

 

[Peter_SSs]

You are welcome. Glad we could help.