Finding multiple results

[asjmoron]

Hi All,

I am having a real hard time trying to explain what am actually trying to do as result so I have tried to demo it below.

I need to change this

[TABLE="width: 128"]
<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Ref[/TD]
[TD="width: 64"]Result[/TD]
[/TR]
[TR]
[TD]a123[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]b123[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]c123[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]a123[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]a123[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]b123[/TD]
[TD="align: right"]1[/TD]
[/TR]
</tbody>[/TABLE]


into this

[TABLE="width: 128"]
<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"]a123[/TD]
[TD="class: xl65, width: 64"]1, 2 ,1[/TD]
[/TR]
[TR]
[TD="class: xl65"]b123[/TD]
[TD="class: xl65"]2, 1[/TD]
[/TR]
[TR]
[TD="class: xl65"]c123[/TD]
[TD="class: xl65"]3
[/TD]
[/TR]
</tbody>[/TABLE]


And I dont know the best way to do it (or if it is actually possible).

There are around 15,000 records with about 30% of them being duplicates of the ref (a maximum of 11 duplicates) but the reult can be any number. Any advise would be very welcomed.

 

[Special-K99]

This is a common request, concatenating results. Not easily possible with simple formulas.
May be possible with Power Query, certainly possible with VBA, though I'm no expert on either.

 

[mohadin]

Hi
May be

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

If your data starts at A2,B2

 

[asjmoron]

Hi
May be

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

If your data starts at A2,B2

This almost works. The ref is colum A but the results are in C. I tried making (what I thought would be) the ammendment but it didnt work. I am loking to have the output in Column J if that helps?

 

[mohadin]

Ok
just

 Cells(2, [COLOR=#ff0000]10[/COLOR]).Resize(.Count, 2) = Application.Transpose(Array(.Keys, .Items))

 

[asjmoron]

we did it! By Jove I think we did it!

I had to make another small adjustment (a(i, 3)) but its working now.

Thanks!

 

[mohadin]

You are well come
Thanks for the feedback
Be happy