Searching comma separated values from range of comma separated values

[Sadiqmcool]

Hi Friends,

i Have a difficult question to explain.
As you see in below table, columns in green i have, column in red i am trying to get as result.

Problem statement:
Values of B column it should search in range (B2:B5), if a comma separated string is occurring in the range then it should return the in which all cells it is available.

Example:
abc form cell B2 is repeated in B4.
hij from cell B2 is repeated in B3 and so on

Expected result is shown in duplicate column

Category	Teams	Count	Duplicate
Boys_19	abc, hij, xyz	3	Boys_19 Girls_19 Boys_14
Girls_19	efg, hij	2	Boys_19 Girls_19
Boys_14	nop, qrs, abc	3	Boys_14 Boys_19
Girls_14	klm, afo	2

<colgroup><col span="3"><col></colgroup><tbody>
</tbody>

Thank you

 

[MickG]

Try this:-
NB:- If your not sure how to use this code, Call Back !!!

[COLOR="Navy"]Sub[/COLOR] MG08Jun20
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, R [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng
  Sp = Split(R.Value, ", ")
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
         [COLOR="Navy"]If[/COLOR] Not .exists(Sp(n)) [COLOR="Navy"]Then[/COLOR]
            .Add (Sp(n)), R
         [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] .Item(Sp(n)) = Union(.Item(Sp(n)), R)
     [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Dim[/COLOR] J [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
 [COLOR="Navy"]If[/COLOR] Not .Item(K) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] .Item(K).Count > 1 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] J = Nothing: Txt = ""
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] J [COLOR="Navy"]In[/COLOR] .Item(K)
            Txt = Txt & IIf(Txt = "", J.Offset(, -1).Value, ", " & J.Offset(, -1).Value)
        [COLOR="Navy"]Next[/COLOR] J
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] J [COLOR="Navy"]In[/COLOR] .Item(K)
            J.Offset(, 2) = J.Offset(, 2) & IIf(J.Offset(, 2).Value = "", Txt, ", " & Txt)
        [COLOR="Navy"]Next[/COLOR] J
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick