Pull together same category winners VBA? or Textjoin

[szita2000]

Hi Guys.

I am trying to find a solution to this.
I have a list of winners and categories they won in.

	K	L
Jimmy John	Singing
Billy Bob	Dancing
Sue Partridge	Singing
Jones Smith	Guitar
Blake Boris	Drum
John Wellington	Guitar

<tbody>
[TD="align: center"]20[/TD]

[TD="align: center"]21[/TD]

[TD="align: center"]22[/TD]

[TD="align: center"]23[/TD]

[TD="align: center"]24[/TD]

[TD="align: center"]25[/TD]

</tbody>

​

I need to pull them together where each category have one cell and the winners are displayed with a separator. Like a result of a SUMIF only to "Bring me out if..."

	A	B
Singing	Jimmy John, Sue Partridge
Dancing	Billy Bob
Guitar	Jones Smith, John Wellington
Drum	Blake Boris

<tbody>
[TD="align: center"]24[/TD]

[TD="align: center"]25[/TD]

[TD="align: center"]26[/TD]

[TD="align: center"]27[/TD]

</tbody>

1. Is there any way to do this with formula, or I will need to do it with VBA?
I am aware of the new TEXTJOIN formula, but I can't figure out, how would I get out the first, second and nth occurence.

2.How would you do it in VBA?
My best guess is to loop through each category and if it matches the list, bring out the name. with an offset + a separator

Thanks

Thomas

 

[Fluff]

How about

Book1
	A	B	I	J	K	L
20					Jimmy John	Singing
21					Billy Bob	Dancing
22					Sue Partridge	Singing
23					Jones Smith	Guitar
24	Singing	Jimmy John, Sue Partridge			Blake Boris	Drum
25	Dancing	Billy Bob			John Wellington	Guitar
26	Guitar	Jones Smith, John Wellington
27	Drum	Blake Boris
RC

Cell Formulas
Range	Formula
B24	{=TEXTJOIN(", ",TRUE,IF($L$20:$L$25=A24,$K$20:$K$25,""))}
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[szita2000]

Hi Fluff.

Thanks again!

You know, the beauty of this solution is that it is so simple once you decipher it.
Thanks a mill.

 

[Fluff]

You're welcome & thanks for the feedback

 

[mohadin]

Hi there
And if you like a vba code Try this

Sub test()
    Dim a As Variant, lr
    a = Range("k20:k" & Cells(Rows.Count, 11).End(xlUp).Row).Resize(, 2)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If Not .exists(a(i, 2)) Then
                .Add a(i, 2), a(i, 1)
            Else
                .Item(a(i, 2)) = .Item(a(i, 2)) & "," & a(i, 1)
            End If
        Next
        Range("a24").Resize(.Count) = Application.Transpose(.Keys)
        Range("b24").Resize(.Count) = Application.Transpose(.items)
    End With
End Sub

 

[Artik]

Something similar to mohadin's code.
Before running the macro, select the source range.

Sub Consolidate()


    Dim dic1        As Object
    Dim rngS        As Range
    Dim varData     As Variant
    Dim i           As Long
    Dim rngDest     As Range


    Set rngS = Selection


    varData = rngS.Value


    Set dic1 = CreateObject("Scripting.Dictionary")


    For i = 1 To UBound(varData)
        If dic1.Exists(varData(i, 2)) Then
            dic1(varData(i, 2)) = dic1(varData(i, 2)) & ", " & varData(i, 1)
        Else
            dic1.Add varData(i, 2), varData(i, 1)
        End If
    Next i


    On Error Resume Next
    Set rngDest = Application.InputBox("Choose destination", Type:=8)
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
    
    rngDest.Resize(dic1.Count).Value = Application.Transpose(dic1.Keys)
    rngDest.Offset(, 1).Resize(dic1.Count).Value = Application.Transpose(dic1.Items)


End Sub

Artik