VBA Remove Duplicates letters from cell

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
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:

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

bs0d

Well-known Member
Joined
Dec 29, 2006
Messages
622
I wonder what would happen if you added a condition if the character is numeric to ignore and advance the loop.
 

kgkev

Well-known Member
Joined
Jun 24, 2008
Messages
1,245
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:

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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
 

kgkev

Well-known Member
Joined
Jun 24, 2008
Messages
1,245

ADVERTISEMENT

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

Well done MickG
 

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Thank you MickG as always, you sir are a legend. Thank you kgKev for your input aswell.
 

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,823
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>
 

Watch MrExcel Video

Forum statistics

Threads
1,108,655
Messages
5,524,124
Members
409,561
Latest member
ay123

This Week's Hot Topics

Top