Check repetition of text in a single cell in excel & delete them to avoid repetition

[arjun0014]

I have thousands of rows like that -
These are the keywords
[TABLE="width: 604"]
<tbody>[TR]
[TD="width: 604"]A1 NEW NIVIA TOP GRIP BASKETBALL SIZE 7 OFFICIAL STREET A++ QUALITY BASKETBALL
[TABLE="width: 604"]
<tbody>[TR]
[TD="width: 604"]A2 New IXO Collated Screw Gun (Cordless) home use screw gun cordless for everyone[TABLE="width: 604"]
<tbody>[TR]
[TD="width: 604"]A3 Set of 3 stainless steel soup pasta salad bowl chicken soup bowl cookware[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

There is a repetition like in A1 - Basketball , in A2 Gun & in A3 soup bowl . I want excel to find these duplicates text , place them in next corresponding column say in B1 B2 B3 etc. And in third column it would remove these duplicates and place text in C1 C2 C3 . Below are the samples

[TABLE="width: 500"]
<tbody>[TR]
[TD]NEW NIVIA TOP GRIP BASKETBALL SIZE 7 OFFICIAL STREET A++ QUALITY BASKETBALL[/TD]
[TD]Basketball[/TD]
[TD]NEW NIVIA TOP GRIP BASKETBALL SIZE 7 OFFICIAL STREET A++ QUALITY[/TD]
[/TR]
[TR]
[TD]New IXO Collated Screw Gun (Cordless) home use screw gun cordless for everyone[/TD]
[TD]Gun , screw[/TD]
[TD]New IXO Collated Screw Gun (Cordless) home use cordless for everyone[/TD]
[/TR]
[TR]
[TD]Set of 3 stainless steel soup pasta salad bowl chicken soup bowl cookware[/TD]
[TD]Soup bowl[/TD]
[TD]Set of 3 stainless steel soup pasta salad bowl chicken cookware[/TD]
[/TR]
</tbody>[/TABLE]


Hope this information helps.
Waiting for early response in this concern.

 

[MickG]

Are you Prepared to use VBA to obtain the correct results. ????

 

[István Hirsch]

Try these UDFs:

B1:

Function Dupl(s As String) As String
s = UCase(s)
x = Split(s)
For i = 0 To UBound(x)
For k = i + 1 To UBound(x)
If x(i) = x(k) Then Dupl = Dupl & "," & x(k)
Next
Next
Dupl = Right(Dupl, Len(Dupl) - 1)
End Function


C1:

Function RemDupl(s As String) As String
s = UCase(s)
x = Split(s)
For i = 0 To UBound(x)
For k = i + 1 To UBound(x)
If x(i) = x(k) Then x(k) = ""
Next
Next
RemDupl = Application.Trim(Join(x))
End Function

 

[István Hirsch]

I forgot to mention that your text has either chr(32) or chr(160) characters as spaces, the UDFs above work if you first convert each space into chr(32) characters.

 

[arjun0014]

I Tried the same.
I Opened VB , insert- module, pasted these codes.
And run the file. But it is showing Invalid outside procedure.

 

[arjun0014]

Yes

 

[MickG]

Try this on you data sheet.
Data in "A" :- Results in "B & C"

[COLOR="Navy"]Sub[/COLOR] MG20Nov37
[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] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] mStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant
[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
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), 1
    [COLOR="Navy"]Else[/COLOR]
        .Item(Sp(n)) = .Item(Sp(n)) + 1
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]If[/COLOR] .Item(K) > 1 [COLOR="Navy"]Then[/COLOR]
        mStr = mStr & IIf(mStr = "", K, " " & K)
    [COLOR="Navy"]Else[/COLOR]
        nStr = nStr & IIf(nStr = "", K, " " & K)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
    Dn.Offset(, 1).Value = mStr
    Dn.Offset(, 2).Value = nStr
    .RemoveAll: nStr = "": mStr = ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[István Hirsch]

Try this on you data sheet.
Data in "A" :- Results in "B & C"

[COLOR=Navy]Sub[/COLOR] MG20Nov37
[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] nStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] mStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] Sp [COLOR=Navy]As[/COLOR] Variant, K [COLOR=Navy]As[/COLOR] Variant
[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
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), 1
    [COLOR=Navy]Else[/COLOR]
        .Item(Sp(n)) = .Item(Sp(n)) + 1
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
    [COLOR=Navy]If[/COLOR] .Item(K) > 1 [COLOR=Navy]Then[/COLOR]
        mStr = mStr & IIf(mStr = "", K, " " & K)
    [COLOR=Navy]Else[/COLOR]
        nStr = nStr & IIf(nStr = "", K, " " & K)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] K
    Dn.Offset(, 1).Value = mStr
    Dn.Offset(, 2).Value = nStr
    .RemoveAll: nStr = "": mStr = ""
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

At me your code deleted both occurrences (of basketball, for example).

 

[arjun0014]

Thanks Mick. Problem solver. Great work !!!

 

[arjun0014]

Thanks Mick, Problem solver. Really brilliant & elegant solution !!