Excel VBA - How to delete duplicate inside the same cell

Wilder1626
CERTIFIED EXPERT
Published:
Updated:
I was asked this week if it was possible to delete duplicated values inside the same cell, since the the function: DATA / REMOVE DUPLICATES functionality was only working for a selection of columns / range etc.
Remove-duplicates.pngIn a couple of minutes, you will be able to create a macro that will be able to search into a range if duplicated values are showing in a single cell and remove it.


If, for example, in one single cell we have the values:
Steve, Marc, Alex, Carla, Marc, Carla, Paul

Once the macro run, it will convert to:
Steve, Marc, Alex, Carla, Paul

This is because Marc and Carla are showing twice.

Let's start with the process for the macro.

Step 1:
The first step is to select the column with duplicated values. In my example , Let's say that we have multiple same value in same cells in Column A and rows 2 to 19.

Once we know the target column, we are now able to start the macro.

Step 2:
Typing ALT + F11 keys opens the Microsoft Visual Basic for Applications window.

On the Insert menu, click Module.

Copy the below code into the code window of the module:
Sub Remove_Duplicates()
                      
                      Dim firstvalue As String
                          Dim lastvalue As String
                          Dim arraystr() As String
                          Dim x As Long
                          Dim k As Long
                          Dim cell As Range
                          Dim rw As Long
                      
                      Application.ScreenUpdating = False
                           ' for each cells in the range
                          For Each cell In Sheets("Sheet1").Range("A2:A19")
                              Erase arraystr ' erase array
                              lastvalue = "" ' erase final value"
                              firstvalue = cell.Value
                              On Error Resume Next
                               
                              arraystr = Split(firstvalue, ",")
                               
                               'Go into the full string and find duplication
                              For rw = 0 To UBound(arraystr)
                                   
                                  For k = rw + 1 To UBound(arraystr)
                                      If Trim(arraystr(k)) = Trim(arraystr(rw)) Then
                                          arraystr(k) = "" 'if this is a duplication, delete the array value
                                      End If
                                  Next k
                              Next rw
                               
                               ' combine all the values without the duplicates
                              For x = 0 To UBound(arraystr)
                                  If arraystr(x) <> "" Then
                                       
                                      lastvalue = lastvalue & Trim(arraystr(x)) & ", "
                                  End If
                              Next x
                               ' Then delete the last empty space plus the extra comma
                              lastvalue = Trim(lastvalue)
                              lastvalue = Left(lastvalue, Len(lastvalue) - 1)
                      
                              cell.Offset(0, 0).Value = lastvalue
                          Next cell
                      
                          'AutoSize the column A an the end
                          Columns("A:A").Select
                          Selection.EntireColumn.AutoFit
                      
                      Application.ScreenUpdating = True
                      End Sub

Open in new window


Now, If we want to run the macro from the module window, we can press F5.

Once completed with the macro, click Close and Return to Microsoft Excel on the File menu.

The above macro will only leave single values in each cells and at the end, also AutoSize the column A.

We can now Run this macro by selecting DEVELOPER tab and select MACROS.

You will see the new macro called: Remove_Duplicates



Run-macro.png

You can also customize the macro as you like, based on your needs.

If, for example, you want to run the macro on another column and with a bigger range, you can update this part of the code:
  ' for each cells in the range
                          For Each cell In Sheets("Sheet1").Range("A2:A19")

Open in new window


Example:
We can use the column F from row 1 to 200. The code would turn to:

  ' for each cells in the range
                          For Each cell In Sheets("Sheet1").Range("F1:F200")

Open in new window


If you want to use the macro on column A, but for multiple sheets, you just need to remove the Sheets section like below:
  ' for each cells in the range
                          For Each cell In Range("A1:A200")

Open in new window

If you want to run this macro on multiple columns, you need adjust the range as you like.

Example for column A to G and rows 1 to 300:
' for each cells in the range
                          For Each cell In Range("A1:G300")

Open in new window


 
2
9,222 Views
Wilder1626
CERTIFIED EXPERT

Comments (3)

aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT
Top Expert 2014

Commented:
1. A dictionary object would be much faster than an array iteration to find your duplicates.  Your code would be simpler as well.

2. You should parameterize your code so that it receives a range parameter rather than using hard coded ranges.  Although it is not an in-place substitution, you can see an example of parameterized user-defined function in my Better Concatenation Function article.  
http:A_7811.html

Alternatively, your code can prompt the user to select a range.  In Excel, you have the ability to use the Application.Inputbox method with a data type of Range (8).

3. Like the range, you might allow the user to supply the delimiter.

4. If you had used a comma-space ", " delimiter rather than just the comma delimiter "," , you could eliminate the need to trim your split results.  Any trimming actions could also be a parameterized/prompted.
aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT
Top Expert 2014

Commented:
Did you look at parsing the cell contents independent of the delimiters?  If you used the regular expression object, you could get just the words.
Example:
    Const cCellData As String = "Steve, Marc,      Alex, Carla; Marc.     Carla, Paul"
    Dim oRE As Object
    Dim oMatches As Object
    Dim oM As Object

    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    oRE.Pattern = "\w+"

    If oRE.test(cCellData) Then
        Set oMatches = oRE.Execute(cCellData)
        for each oM in oMatches
            Debug.Print oM.Value
        next
    end if

Open in new window

Produces the following results in the Immediate window:
Steve
Marc
Alex
Carla
Marc
Carla
Paul

Open in new window

aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT
Top Expert 2014

Commented:
5. Once you have your unique values, you should probably use the Join() function.  It is very efficient.

If you used a dictionary object, you can do this:
rngCell.Value = Join(dicUnique.Keys, ", ")

Open in new window

Where rngCell refers to the current cell in your range iteration and dicUnique is a dictionary object variable with unique names.

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.