Identify series of duplicate numbers in a cell

[arunsri07]

I have a datasheet with duplicates values in single cell. I would like to delete them using Macro.


Example: [TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD][TABLE="width: 543"]
<tbody>[TR]
[TD="width: 543"]108,125,98,90,113,64,89,71;61,38,57,53,51,30,39;29,25,19,7,5,61,38,57,53,51,30,39,29,25,19,7,5,61,38,57,53,51,30,39,29,25,19,7,5;61,38,57,53,51,30,39;29,25,19,7,5[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 543"]
<tbody>[TR]
[TD="width: 543"]34;19,12,9,6,19,12,9,6,19,12,9,6;19,12,9,6[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


Currently I am using this code, but it only seems to highlight duplicates, also only words not numbers.

[COLOR=#333333]Sub findspaces()[/COLOR]    lastrow = Range("A65536").End(xlUp).Row
    
    For I = 1 To lastrow
        'x = 0
        ask = Split(Cells(I, 1), " ")
        For j = LBound(ask) To UBound(ask) - 1
            x = 0
            For k = j + 1 To UBound(ask)
                If ask(j) = ask(k) Then
                    x = x + 1
                End If
            Next k
            
            If x > 0 Then
                pos = 0
                For L = 1 To x + 1
                    pos = InStr(pos + 1, Cells(I, 1), ask(j))
                    Cells(I, 1).Select
                    With ActiveCell.Characters(Start:=pos, Length:=Len(ask(j))).Font
                        .Color = -16776961
                    End With
                Next L
            End If
        Next j
    Next I
       [COLOR=#333333]End Sub[/COLOR]

Any suggestions would be very much appreciated.

Thanks in advance

 

[MickG]

Try this for Duplicate Data in "A1" replaced by Unique Data in "A1".

[COLOR="Navy"]Sub[/COLOR] MG02Oct38
[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, nstr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Sp = Split(Replace(Range("A1"), ";", ","), ",")
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Sp(n)) [COLOR="Navy"]Then[/COLOR]
        nstr = nstr & IIf(nstr = "", Sp(n), ", " & Sp(n))
        .Add Sp(n), Nothing
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("A1") = nstr
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[arunsri07]

Try this for Duplicate Data in "A1" replaced by Unique Data in "A1".

[COLOR=Navy]Sub[/COLOR] MG02Oct38
[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, nstr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Sp = Split(Replace(Range("A1"), ";", ","), ",")
[COLOR=Navy]For[/COLOR] n = 0 To UBound(Sp)
    [COLOR=Navy]If[/COLOR] Not .Exists(Sp(n)) [COLOR=Navy]Then[/COLOR]
        nstr = nstr & IIf(nstr = "", Sp(n), ", " & Sp(n))
        .Add Sp(n), Nothing
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
Range("A1") = nstr
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Hi Mick,


It doesn't seem to work unfortunately. But thanks for looking into it, might have any other suggestions?

 

[MickG]

See example here !!!
https://app.box.com/s/t25mi40ecxqblqaau8wn3ng2kxvvwf0e

 

[Peter_SSs]

Welcome to the MrExcel board!

Is what you have shown in the box in post #1 all in 1 cell, 2 cells, 3 cells, 4 cells (including a blank cell), or something else?

What are the expected results for the sample data you gave?

Do you really have some of the numbers separated by commas and some by semicolons?

When a suggestion does not do what you want, just saying "It doesn't work" doesn't give the helper much to go on!
- Did it produce the wrong results (in what way?)?
- Did it produce the right results but in the wrong place?
- Did it do nothing?
- Did it give an error message (details)?
- etc

 

[arunsri07]

See example here !!!
https://app.box.com/s/t25mi40ecxqblqaau8wn3ng2kxvvwf0e

Hi Mick,

Thanks for the example it works fine, I am sorry didn't manage to it it into my Data.

I have a column to filter, you might have a code that might fit this scenario?


Many thanks,
Arun

 

[MickG]

Try this for data in column "A".
NB:- If you run this code from the Macro Dialog Box, make sure your data sheet is visible

[COLOR="Navy"]Sub[/COLOR] MG02Oct30
[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, nstr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[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(Replace(Dn.Value, ";", ","), ",")
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Sp(n)) [COLOR="Navy"]Then[/COLOR]
        nstr = nstr & IIf(nstr = "", Sp(n), ", " & Sp(n))
        .Add Sp(n), Nothing
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
    Dn.Value = nstr
    nstr = ""
    .RemoveAll
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[arunsri07]

Try this for data in column "A".
NB:- If you run this code from the Macro Dialog Box, make sure your data sheet is visible

[COLOR=Navy]Sub[/COLOR] MG02Oct30
[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, nstr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[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(Replace(Dn.Value, ";", ","), ",")
[COLOR=Navy]For[/COLOR] n = 0 To UBound(Sp)
    [COLOR=Navy]If[/COLOR] Not .Exists(Sp(n)) [COLOR=Navy]Then[/COLOR]
        nstr = nstr & IIf(nstr = "", Sp(n), ", " & Sp(n))
        .Add Sp(n), Nothing
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
    Dn.Value = nstr
    nstr = ""
    .RemoveAll
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Hi Mick,


Thank you so much it works perfectly.

Thank you
Arun

 

[MickG]

You're welcome