Duplicate Entry, Concatenate Value

[myempyrean]

Long time reader, first time poster.

I've looked for hours on the board for a solution here, so I apologize if this is a duplicate. I'm fairly newbie at some of these complicated formulas. Briefly, here's my input table and desired output table:

Input - Sheet 1:

Entry Value
ag1 pl1

ag3 pl2
ag3 pl3


ag2 pl4
ag1 pl5

ag2 pl2
ag4 pl3
ag5 pl1

NOTE: These values come from an exported document and are pasted into the worksheet. The order in which these are entered varies every week, and the list is ~5000 items long.


Output - Sheet 2:

Entry Value
ag1 pl1 & pl5

ag4 pl3

ag2 pl4 & pl2
ag3 pl2 & pl3
ag5 pl1

NOTE: In no particular order. The Value must match the Entry such that the table can be filtered. The Entries are singular on Sheet 2 and pre-existing, but the Values must match and be concatenated within the cell.



Ideally, the Sheet 2: Value column is the only formula within the cell, but it may be possible to add additional columns.

Looking for the least expensive (cpu wise) solution... but really any solution would be amazing right now. Vlookup has its challenges with multiple entreis, and I've been monkeying around with Index/Match but haven't come up with a working solution yet.

Thank you all very much in advance for your help.

-Chris

 

[Domenic]

Maybe...

[font=Courier New][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] ListUniqueValues()

    [color=darkblue]Dim[/color] objDict [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] MyArray() [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] wksSht1 [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksSht2 [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Set[/color] objDict = CreateObject("Scripting.Dictionary")
    
    [color=darkblue]Set[/color] wksSht1 = Worksheets("Sheet1")
    [color=darkblue]Set[/color] wksSht2 = Worksheets("Sheet2")
    
    [color=darkblue]With[/color] wksSht1
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        [color=darkblue]For[/color] i = 2 [color=darkblue]To[/color] LastRow
            [color=darkblue]If[/color] .Cells(i, "A").Value <> "" [color=darkblue]Then[/color]
                [color=darkblue]If[/color] [color=darkblue]Not[/color] objDict.Exists(.Cells(i, "A").Value) [color=darkblue]Then[/color]
                    Cnt = Cnt + 1
                    [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] MyArray(1 [color=darkblue]To[/color] 2, 1 To Cnt)
                    MyArray(1, Cnt) = .Cells(i, "A").Value
                    MyArray(2, Cnt) = .Cells(i, "B").Value
                    objDict.Add .Cells(i, "A").Value, Cnt
                [color=darkblue]Else[/color]
                    MyArray(2, objDict.Item(.Cells(i, "A").Value)) = MyArray(2, objDict.Item(.Cells(i, "A").Value)) & " & " & .Cells(i, "B").Value
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] i
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] wksSht2
        .Cells(1, "A").Value = wksSht1.Cells(1, "A").Value
        .Cells(1, "B").Value = wksSht1.Cells(1, "B").Value
        .Cells(2, "A").Resize(UBound(MyArray, 2), 2) = WorksheetFunction.Transpose(MyArray)
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    wksSht2.Activate

[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[myempyrean]

Apologies for getting back to this so late.

It's been a while since I've gotten into the VBA in Excel -- would this be something run through a macro/button? It sure would be awesome if we could come up with something that was integrated and updated real-time.

Thank you very much for the reply!!

 

[Domenic]

Placing a button on your worksheet is one option. First, open your workbook and place the code in a regular module...

1. Open the Visual Basic Editor by pressing Alt+F11.
2. Insert a standard module by selecting from the menu 'Insert > Module'.
3. Copy and paste the code into the module.
4. Return to Microsoft Excel by pressing Alt+Q.

Then, place a button on your worksheet by selecting...

Developer > Controls > Insert > Form Controls > Button

When the 'Assign Macro' dialogue box is displayed, select 'ListUniqueValues', and click Ok. Now, when you want to run the macro, simply click on the button. By the way, make sure that you change the sheet names in the code, accordingly.