group by column

[sthay]

Dear Expert

I have an excel with two columns. I am trying to pretty much group by column A and concatenate column B and put the concatenate string into column C as depicts in first screenshot.

Second screenshot is my unfinished codes and I am not certain how to get it works.

I hope you can help.

Thanks

[Bob Phillips]

Try this


Sub combineSubject()
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 2 Step -1

.Cells(i, "C").Value = .Cells(i, "B").Value
If .Cells(i, "A").Value = .Cells(i + 1, "A").Value Then

.Cells(i, "C").Value = .Cells(i, "C").Value & " + " & .Cells(i + 1, "C").Value
.Cells(i + 1, "C").Value = vbNullString
End If
Next i

.Cells(1, "C").Value = "output"
End With
End Sub

[arnelgp]

Option Explicit


Sub subConcat()
Const SHT As String = "Sheet1"
Dim lngLastRow As Long
Dim arr As Variant
Dim i As Long, current_group As String
Dim current_row As Long, strConcat As String
Dim j As Long

' make sure the worksheet is sorted
With ActiveWorkbook.Worksheets(SHT)
lngLastRow = .Range("A1").CurrentRegion.Rows.Count
.Range("C2:C" & lngLastRow).Cells.Delete
.Range("A1:B" & lngLastRow).Select
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=.Range("A2:A" & lngLastRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add2 Key:=.Range("B2:B" & lngLastRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange ActiveWorkbook.Worksheets(SHT).Range("A1:B" & lngLastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' concatenate
j = 2
arr = .Range("A2:B" & lngLastRow)
For i = 1 To UBound(arr)
If current_group <> arr(i, 1) Then
.Range("C" & j) = strConcat
j = i + 1
current_group = arr(i, 1)
strConcat = arr(i, 2)
Else
strConcat = strConcat & " + " & arr(i, 2)
End If
Next
.Range("C" & j) = strConcat
.Range("C1") = "output"
.Range("A1").Select
End With

End Sub

[sthay]

Thanks for your time in getting back to me Bob.

The excel data above is simply a mockup excel data to demonstrate my question. In fact, column A can contain varieties of data and there are at least a few thousand of rows.

Do you have solution to that?

Thanks in advance



Try this


Sub combineSubject()
Dim lastrow As Long
Dim i As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 2 Step -1

.Cells(i, "C").Value = .Cells(i, "B").Value
If .Cells(i, "A").Value = .Cells(i + 1, "A").Value Then

.Cells(i, "C").Value = .Cells(i, "C").Value & " + " & .Cells(i + 1, "C").Value
.Cells(i + 1, "C").Value = vbNullString
End If
Next i

.Cells(1, "C").Value = "output"
End With
End Sub

[Bob Phillips]

Does the code not work in that case?