<

Excel VBA - How to delete duplicate inside the same cell

Published on
8,005 Points
4,805 Views
2 Endorsements
Last Modified:
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
Comment
Author:Wilder1626
  • 3
3 Comments
 
LVL 47

Expert Comment

by:aikimark
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.
0
 
LVL 47

Expert Comment

by:aikimark
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

0
 
LVL 47

Expert Comment

by:aikimark
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.
0

Featured Post

Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

Join & Write a Comment

This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month