Code or formula to Combine Duplicates

[RaydenUK]

How can I combine the tags at the end of my ID #'s if I have duplicate values? Specifically, I have a dynamic list of ID numbers that are regularly put into a spreadsheet and depending on what the patient needs, a tag is put on to the end of the #. For example: Patient 14454 may need test "B" ran. Therefore the ID # would become 14454_B. Sometimes the same patient can be ran more than once with different tags, such as 14454_A, 14454_B, and 14454_APS. How could I have Excel, whether through vba or a formula, to put these tags together like this: 14454_A,B,APS ? I appreciate any help. Thank you.

Here is a sample with a before (table on top) and after (table on bottom)[TABLE="width: 500"]
<tbody>[TR]
[TD]Id #[/TD]
[TD]Method[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]4321[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]7412[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]9632[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1478[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]Dbr[/TD]
[/TR]
[TR]
[TD]2145[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1478[/TD]
[TD]Dbr[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="width: 500"]
<tbody>[TR]
[TD]id#_method[/TD]
[/TR]
[TR]
[TD]1234_A,B,Dbr[/TD]
[/TR]
[TR]
[TD]4321_A[/TD]
[/TR]
[TR]
[TD]7412_B[/TD]
[/TR]
[TR]
[TD]9632_D[/TD]
[/TR]
[TR]
[TD]1478_G,Dbr[/TD]
[/TR]
[TR]
[TD]2145_G[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this:-
Results in column "D".

[COLOR="Navy"]Sub[/COLOR] MG30Apr50
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn & "_" & Dn.Offset(, 1)
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & ", " & Dn.Offset(, 1)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("D1").Resize(.Count) = Application.Transpose(.items)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[RaydenUK]

WOW that Worked Perfectly!!! Thank you So much Mick. You truly are a lifesaver.

 

[MickG]

You're welcome

 

[RaydenUK]

How do I prevent it from posting duplicate methods for the same ID#? For example:

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID #[/TD]
[TD]Method[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]A[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID #_Method[/TD]
[/TR]
[TR]
[TD]123_A,A[/TD]
[/TR]
</tbody>[/TABLE]

I just want it to say 123_A instead of 123_A,A

 

[MickG]

Try this:-
Results column "D".

[COLOR="Navy"]Sub[/COLOR] MG01May03
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Str         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]


[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
                Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Empty
       [COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
    c = c + 1
    Str = Str & k & "_"
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k): Str = Str & p & ", ": [COLOR="Navy"]Next[/COLOR] p
        cells(c, "D") = Left(Str, Len(Str) - 2)
            Str = ""
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[RaydenUK]

That works Perfect, thank you so much. I just realized though is there anyway to add in a third column, like "name", that will stay with the ID#_Method? Like I said the code works perfect and would hate to lose and of it's functionality, I would just like to add this other column to it
Heres an example:

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID#
[/TD]
[TD]Method[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]A[/TD]
[TD]Bill Smith[/TD]
[/TR]
[TR]
[TD]321[/TD]
[TD]B[/TD]
[TD]Tom Jones[/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]A[/TD]
[TD]Bill Smith[/TD]
[/TR]
[TR]
[TD]321[/TD]
[TD]C[/TD]
[TD]Tom Jones[/TD]
[/TR]
</tbody>[/TABLE]

And give this as a result:

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID#_Method[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]123_A[/TD]
[TD]Bill Smith[/TD]
[/TR]
[TR]
[TD]321_B,C[/TD]
[TD]Tom Jones[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I am super appreciative of you help.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG02May07
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Str         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]


[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
                Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Dn.Offset(, 2)
       [COLOR="Navy"]Next[/COLOR] Dn




[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
    Temp = ""
    c = c + 1
    Str = Str & k & "_"
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k): Str = Str & p & ", ": Temp = Dic(k).Item(p): [COLOR="Navy"]Next[/COLOR] p
       cells(c, "D") = Left(Str, Len(Str) - 2)
         cells(c, "E") = Temp
            Str = ""
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick