VBA Remove Duplicates letters from cell

[decadence]

Hi, I am trying to remove duplicate letters from cells, however the code below works fine on letters but when there are numbers involved it doesn't end well. What I would like to do is remove all duplicate letters from a cell even if there are numbers present. Can someone help with this.

Sub LetterDupes()

    Dim Str As String, xChar As String, MyStr As String, x As range, Rng As range
    Set xDic = CreateObject("Scripting.Dictionary")
    Set Rng = ActiveSheet.UsedRange
    For Each x In Rng
        Str = x
    For i = 1 To VBA.Len(Str)
        xChar = VBA.Mid(Str, i, 1)
            If xDic.Exists(xChar) Then
        Else
            xDic(xChar) = ""
            MyStr = MyStr & xChar
        End If
    Next
    Next x
    Rng = MyStr
End Sub

Example:
From This..
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]CC1, CC32, CC33, CC18
[/TD]
[/TR]
[TR]
[TD]RR7
[/TD]
[/TR]
[TR]
[TD]DD123 DD54_2
[/TD]
[/TR]
</tbody>[/TABLE]

To This..
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]C1, C32, C33, C18
[/TD]
[/TR]
[TR]
[TD]R7
[/TD]
[/TR]
[TR]
[TD]D123 D54_2
[/TD]
[/TR]
</tbody>[/TABLE]

 

[bs0d]

I wonder what would happen if you added a condition if the character is numeric to ignore and advance the loop.

 

[kgkev]

Its not to do with the numbers,

In your first examples
CC1, CC32, CC33, CC18

If accepts the first letter "C" then removes all others

C1, 32, 33, 18

It then checks and accepts the only number 1
C1, 32, 33, 18

Then removes the duplicate commas
C1, 32 33 18

Then the spaces
C1, 323318

Then the number 3s
giving a final result of C1, 3218


try this

Function Dupes(startval As Range) As String

Dim xValue As String
Dim xChar As String
Dim xLastChar As String
Dim xOutValue As String
Dim i As Variant

xValue = startval.Value

For i = 1 To VBA.Len(xValue)
    xChar = VBA.Mid(xValue, i, 1)
    
    If i = 1 Then
        xOutValue = xChar
    Else
        xChar = VBA.Mid(xValue, i, 1)
        xLastChar = VBA.Mid(xValue, i - 1, 1)
        If xChar = xLastChar Then
    
        Else
            xOutValue = xOutValue & xChar
        End If
    End If
Next

Dupes = xOutValue

End Function

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG13Jun07
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Aph [COLOR="Navy"]As[/COLOR] Variant, st [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] sp [COLOR="Navy"]As[/COLOR] Variant, nSt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    Rng.Replace What:=", ", Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    sp = Split(Dn.Value, " ")
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Aph [COLOR="Navy"]In[/COLOR] sp
            st = StrConv(Aph, vbUnicode)
                ray = Split(st, vbNullChar)
                [COLOR="Navy"]For[/COLOR] n = 0 To UBound(ray)
                    [COLOR="Navy"]If[/COLOR] ray(n) Like "[a-zA-Z]" [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]If[/COLOR] InStr(nSt, ray(n)) = 0 [COLOR="Navy"]Then[/COLOR]
                            nSt = nSt & ray(n)
                        [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]Else[/COLOR]
                        nSt = nSt & ray(n)
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] n
                nStr = nStr & IIf(nStr = "", nSt, ", " & nSt)
                nSt = ""
        [COLOR="Navy"]Next[/COLOR] Aph
Dn.Value = nStr: nStr = ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[kgkev]

just realised my code had problems with the CC33 outputting C3 instead of C33.

Well done MickG

 

[decadence]

Thank you MickG as always, you sir are a legend. Thank you kgKev for your input aswell.

 

[MickG]

You're welcome

 

[pgc01]

Hi

With the identifiers with letters numbers and underscores, like in the examples, another option:

Sub DeleteDups()
Dim regex As Object, r As Range, rC As Range
Dim s As String

Set r = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))

With CreateObject("VBScript.RegExp")
    .Pattern = "(\w)(\w*)\1"
    .Global = True
    For Each rC In r
        s = rC.Value
        While .test(s): s = .Replace(s, "$1$2"): Wend
        rC.Offset(, 1).Value = s
    Next rC
End With
End Sub

Example: (I write the result in the cell to the left for debug)


<table border="1" cellpadding="1" style="background:#FFF; border-collapse:collapse;border-width:2px;border-color:#CCCCCC;font-family:Arial,Arial; font-size:10pt" ><tr><th style="border-width:1px;border-color:#888888;background:#9CF " > </th><th style="border-width:1px;border-color:#888888;background:#9CF; text-align:center" >A</th><th style="border-width:1px;border-color:#888888;background:#9CF; text-align:center" >B</th><th style="border-width:1px;border-color:#888888;background:#9CF; text-align:center" width=30 >C</th></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>1</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>2</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">CC1, CC32, CC33, CC18</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">C1, C32, C3, C18</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>3</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">RR7</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">R7</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>4</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">DD123 DD54_2</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">D123 D54_2</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>5</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>6</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">a123b123a321 12cc21</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">a123b 12c</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>7</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td colspan=4 style="background:#9CF; padding-left:1em" > [Book1]Sheet1</td></tr></table>