duplicate data delete in multiple rows

[sejun87]

Hi, I'm having a trouble doing text duplicate delete in multiple rows (over 1000)

Imagine there is a data set looks like "initial data"

You would find there there are many duplication within the same cell. While it is below the scroll there are cells that has more than 5 math or 3 english.

What i desire to obtain is the get rid of duplicates in each cell as shown in "desired output"

I know this seems like a relatively easier task, but I can't think of a good way to do this.

Text division doesn't really give much value, especially because there are sometimes more than ~3,000 rows sometimes, i can't do this one by one.

Please shed some lights on!

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG04Apr55
[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
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.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), Nothing
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
        Dn.Value = Join(.keys, "|")
        .RemoveAll
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sejun87]

works fantastically!!! Thanks Mick! Wish I could understand why you named in this way

 

[MickG]

You're welcome