Removing duplicates and sorting within cell

[louisli_evo]

Hi All,

I got another challenge with Excel.

I had a cell containing data like this:

A.5.9, A.5.9, A.5.10, A.5.11, A.5.12, A.5.13, A.5.10, A.7.10, A.7.10, A.7.10, A.5.15, A.5.15, A.5.16, A.5.18, A.8.2, A.5.17, A.5.18, A.5.18, A.5.17, A.8.3, A.8.5, A.5.17, A.8.18,A.8.15, A.8.15, A.8.15, A.8.17, A.8.20, A.8.21, A.8.22, A.5.14, A.5.14, A.5.14, A.6.6, A.5.19, A.5.20, A.5.21, A.5.22, A.5.22, A.5.24, A.6.8, A.6.8, A.5.25, A.5.26, A.5.27, A.5.28

I need to:

1. remove duplicates within the cell
2. Sort each item so they will show in increasing order (e.g. A.5.9, A.5.10, A.5.11, A.5.12...)

I can do it cell by cell manually:

1. Copy the cell contents to a blank sheet (or blank column, whatever) as a row
2. Copy and paste transpose (as a column)
3. Data --> Remove duplicates
4. Sort
   • Text to columns, delimiter, "comma", "space"
   • Sort by column 1, then column 2, then column 3
5. Combine the 3 columns using formula (e.g. D1=A1&B1&C1)
6. (Then I have no idea how to put them back in the same cell, perhaps copy and paste into notepad, remove the spaces, then paste back to the original Cell)

But I wanted to save time for these hundreds of rows, is there any smarter ways to convert them?

Thank you.

 

[louisli_evo]

If there is always a space after the comma, this is my suggestion assuming

• Beta version with latest TEXT functions,
• Single letter prefix (like all samples)
• Single-digit whole number part (like all samples)
• Max 2-digit decimal part (like all samples)

louisli_evo.xlsm
	A	B
1	A.5.9, A.5.9, A.5.10, A.5.11, A.5.12, A.5.13, A.5.10, A.7.10, A.7.10, A.7.10, A.5.15, A.5.15, A.5.16, A.5.18, A.8.2, A.5.17, A.5.18, A.5.18, A.5.17, A.8.3, A.8.5, A.5.17, A.8.18, A.8.15, A.8.15, A.8.15, A.8.17, A.8.20, A.8.21, A.8.22, A.5.14, A.5.14, A.5.14, A.6.6, A.5.19, A.5.20, A.5.21, A.5.22, A.5.22, A.5.24, A.6.8, A.6.8, A.5.25, A.5.26, A.5.27, A.5.28	A.5.9, A.5.10, A.5.11, A.5.12, A.5.13, A.5.14, A.5.15, A.5.16, A.5.17, A.5.18, A.5.19, A.5.20, A.5.21, A.5.22, A.5.24, A.5.25, A.5.26, A.5.27, A.5.28, A.6.6, A.6.8, A.7.10, A.8.2, A.8.3, A.8.5, A.8.15, A.8.17, A.8.18, A.8.20, A.8.21, A.8.22
Sheet1

Cell Formulas
Range	Formula
B1	B1	=LET(ts,TEXTSPLIT(A1,", "),TEXTJOIN(", ",,UNIQUE(SORTBY(ts,TEXTBEFORE(ts,".",-1)&"."&TEXT(TEXTAFTER(ts,".",-1),"00")),1)))

Thank you very much. I will try them out.

 

[bebo021999]

Try with UDF
Alt-F11 to open VBA window, then insert/module, then copy following code into editting window:

Option Explicit
Function SortDup(cell As Range)
Dim i&, j&, k&, s, arr(), tmp As String, tmp2 As String, st As String
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
s = Split(Replace(cell, " ", ""), ",")
ReDim arr(1 To UBound(s) + 1, 1 To 2)
For i = 0 To UBound(s)
    If Not dic.exists(s(i)) Then
        dic.Add s(i), ""
        k = k + 1
        arr(k, 1) = s(i)
        arr(k, 2) = Left(s(i), InStrRev(s(i), ".")) & Format(Mid(s(i), InStrRev(s(i), ".") + 1, 4), "0000")
    End If
Next
For i = 1 To k - 1
    For j = i + 1 To k
        If arr(i, 2) > arr(j, 2) Then
            tmp2 = arr(j, 2): tmp = arr(j, 1)
            arr(j, 2) = arr(i, 2): arr(j, 1) = arr(i, 1)
            arr(i, 2) = tmp2: arr(i, 1) = tmp
        End If
    Next
Next
For i = 1 To k
    st = st & IIf(st = "", arr(i, 1), ", " & arr(i, 1))
Next
SortDup = st
End Function

In B1:

=SortDup(A1)

Book1
	A	B
1	A.5.9, A.5.9, A.5.10, A.5.11, A.5.12, A.5.13, A.5.10, A.7.10, A.7.10, A.7.10, A.5.15, A.5.15, A.5.16, A.5.18, A.8.2, A.5.17, A.5.18, A.5.18, A.5.17, A.8.3, A.8.5, A.5.17, A.8.18,A.8.15, A.8.15, A.8.15, A.8.17, A.8.20, A.8.21, A.8.22, A.5.14, A.5.14, A.5.14, A.6.6, A.5.19, A.5.20, A.5.21, A.5.22, A.5.22, A.5.24, A.6.8, A.6.8, A.5.25, A.5.26, A.5.27, A.5.28	A.5.9, A.5.10, A.5.11, A.5.12, A.5.13, A.5.14, A.5.15, A.5.16, A.5.17, A.5.18, A.5.19, A.5.20, A.5.21, A.5.22, A.5.24, A.5.25, A.5.26, A.5.27, A.5.28, A.6.6, A.6.8, A.7.10, A.8.2, A.8.3, A.8.5, A.8.15, A.8.17, A.8.18, A.8.20, A.8.21, A.8.22
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sheet1

Cell Formulas
Range	Formula
B1	B1	=SortDup(A1)

 

[louisli_evo]

Try with UDF
Alt-F11 to open VBA window, then insert/module, then copy following code into editting window:

Option Explicit
Function SortDup(cell As Range)
Dim i&, j&, k&, s, arr(), tmp As String, tmp2 As String, st As String
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
s = Split(Replace(cell, " ", ""), ",")
ReDim arr(1 To UBound(s) + 1, 1 To 2)
For i = 0 To UBound(s)
    If Not dic.exists(s(i)) Then
        dic.Add s(i), ""
        k = k + 1
        arr(k, 1) = s(i)
        arr(k, 2) = Left(s(i), InStrRev(s(i), ".")) & Format(Mid(s(i), InStrRev(s(i), ".") + 1, 4), "0000")
    End If
Next
For i = 1 To k - 1
    For j = i + 1 To k
        If arr(i, 2) > arr(j, 2) Then
            tmp2 = arr(j, 2): tmp = arr(j, 1)
            arr(j, 2) = arr(i, 2): arr(j, 1) = arr(i, 1)
            arr(i, 2) = tmp2: arr(i, 1) = tmp
        End If
    Next
Next
For i = 1 To k
    st = st & IIf(st = "", arr(i, 1), ", " & arr(i, 1))
Next
SortDup = st
End Function

In B1:

=SortDup(A1)

Book1
	A	B
1	A.5.9, A.5.9, A.5.10, A.5.11, A.5.12, A.5.13, A.5.10, A.7.10, A.7.10, A.7.10, A.5.15, A.5.15, A.5.16, A.5.18, A.8.2, A.5.17, A.5.18, A.5.18, A.5.17, A.8.3, A.8.5, A.5.17, A.8.18,A.8.15, A.8.15, A.8.15, A.8.17, A.8.20, A.8.21, A.8.22, A.5.14, A.5.14, A.5.14, A.6.6, A.5.19, A.5.20, A.5.21, A.5.22, A.5.22, A.5.24, A.6.8, A.6.8, A.5.25, A.5.26, A.5.27, A.5.28	A.5.9, A.5.10, A.5.11, A.5.12, A.5.13, A.5.14, A.5.15, A.5.16, A.5.17, A.5.18, A.5.19, A.5.20, A.5.21, A.5.22, A.5.24, A.5.25, A.5.26, A.5.27, A.5.28, A.6.6, A.6.8, A.7.10, A.8.2, A.8.3, A.8.5, A.8.15, A.8.17, A.8.18, A.8.20, A.8.21, A.8.22
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sheet1

Cell Formulas
Range	Formula
B1	B1	=SortDup(A1)

Wow, Thank you. I will test it soon.