How to concatenate cells in column B based on condition in column A (via VBA loop)-CodePudding

here is the tamplate

Column C with yellow color is my expected result. I'm trying to combine values in column B if their corresponding values in column A are the same. I'd like to solve it through VBA loop as a script below.

I consider that 'collection' method is appropriate in this case, (to store a matrix of loop consequence then extract them by formula Textjoin)

but it doesn't work as my expect...are there any details that I miss?

Thanks for help!

Dim C As Range, BD As Range
Dim i As Long, LR As Long
Dim coll As New Collection
Set BD As Range("A2","A6")
Set LR As Cells(Rows.Count, "A").End(xlUp).Row
For each C in BD
  For i = 2 to LR
    If C.Value = Cells(i, "A").Value Then
    coll.add C.Offset(0, 1).Value
    C.Offset(0, 2).Value = Application.WorksheetFunction.TextJoin(";", True, col)
    End If
  Next i
Next C
End Sub

CodePudding user response：

If I understand you correctly, since my Excel 2010 doesn't have TextJoin function, I try to code like this :

Sub test()
Dim rgData As Range: Dim rg As Range
Dim arr: Dim el
Set rgData = Range("A2:A6")
Set arr = CreateObject("scripting.dictionary")
For Each cell In rgData: arr.Item(cell.Value) = 1: Next
    For Each el In arr
        With rgData
            .Replace el, True, xlWhole, , False, , False, False
            Set rg = .SpecialCells(xlConstants, xlLogical).Offset(0, 1)
            .Replace True, el, xlWhole, , False, , False, False
        End With
        rg.Offset(0, 1) = Join(Application.Transpose(rg), ";")
    Next
End Sub

The code assume that the table/data already sorted by column A. It create unique value from rgData into arr variable. Then it loop to each element in arr as el variable, where on each el, it gets the range of cells which value is the looped el then offset(0,1) as rg variable. Finally it put the result on rg offset(0,1) using "Join".

If I may ask, what does this mean in your code Set BD As Range("A2","A6") .... Set LR As Cells(Rows.Count, "A").End(xlUp).Row ?

Maybe you mean : Set BD = Range("A2","A6") .... LR As Cells(Rows.Count, "A").End(xlUp).Row ?