VBA Remove Duplicates letters from cell

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
525
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
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.

Code:
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..
CC1, CC32, CC33, CC18
RR7
DD123 DD54_2

<tbody>
</tbody>

To This..
C1, C32, C33, C18
R7
D123 D54_2

<tbody>
</tbody>
 
Last edited:

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
I wonder what would happen if you added a condition if the character is numeric to ignore and advance the loop.
 
Upvote 0
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

Code:
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
 
Last edited:
Upvote 0
Try this:-
Code:
[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
 
Upvote 0
just realised my code had problems with the CC33 outputting C3 instead of C33.

Well done MickG
 
Upvote 0
Thank you MickG as always, you sir are a legend. Thank you kgKev for your input aswell.
 
Upvote 0
Hi

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

Code:
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>
 
Upvote 0

Forum statistics

Threads
1,214,938
Messages
6,122,346
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top