merge cells with formula skip duplicates

Question

Our Goal is to merge the names (B) when the data in A is equal. The formula below looks at the next line (A), if it's the same, it merges data (name) from B. The formula is in C, so the result of the merged names will appear in C. =IF(A2<>A3,B2, B2&" , "&B3)

Example: if A2:XYZ and A3:XYZ then merge B2:Sam and B3:Dan in C = "Sam, Dan".

Problem: We need to display all the names merged into one cell (C) that have a matching A, skipping the duplicates..

If A1:A4 = XYZ, and B1:Sam B2=Dan B3=Dan B4=Joe` Then results in C should read "Sam, Dan, Joe"

Any suggestions would be appreciated.

Answer 1

This VBA will sort ascending, remove duplicates, and give you output listing

Sub test()
Application.ScreenUpdating = False
' Sort Ascending
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:B")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Remove Duplicates
    ActiveSheet.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo

'concatenate
Dim data, numrows As Long, result, i As Long, n As Long


If Range("a1") = "" Then Exit Sub

With Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)

    .Sort key1:=Range("a1"), Header:=xlNo
    data = .Value
    numrows = UBound(data)
    ReDim result(1 To numrows, 1 To 1)


    For i = 1 To numrows

    temp = data(i, 1)
    result(i, 1) = result(i, 1) & data(i, 2)

    For n = i + 1 To numrows

        If data(n, 1) = temp Then result(i, 1) = result(i, 1) & ", " & data(n, 2) Else Exit For

    Next

    i = n - 1

    Next

    .Offset(, 2).resize(,1) = result

    End With

    Application.ScreenUpdating = True


End Sub