Please Note: This article is written for users of the following Microsoft Excel versions: 2007, 2010, and 2013. If you are using an earlier version (Excel 2003 or earlier), this tip may not work for you. For a version of this tip written specifically for earlier versions of Excel, click here: Deleting Duplicate Text Values.

Deleting Duplicate Text Values

by Allen Wyatt
(last updated November 9, 2013)

9

Everybody runs into the need at one time or another—to delete duplicate entries from a list of text entries. Suppose you have the text values in column A of a worksheet, and they run for about 500 rows. If you want to delete any duplicates in the list, you may be looking for the easiest way to do it.

Manually, you can use data filtering to determine the unique values. Make sure the column has a label at the top of it, then select a cell in the column. Display the Data tab of the ribbon and click Advanced in the Sort & Filter group. Use the controls in the resulting dialog box to specify that you want to copy the unique values to another location which you specify.

You can also use a formula to manually determine the duplicates in the list. Sort the values in the column, and then enter the following formula in cell B2:

=IF(A2=A1,"Duplicate","")

Copy the formula down to all the cells in column B that have a corresponding value in column A. Select all the values in column B and press Ctrl+C. Use Paste Special to paste just the values into the same selected cells. You've now converted the formulas into their results. Sort the two columns according to the contents of column B, and all of your duplicate rows will be in one area. Delete these rows, and you have your finished list of unique values.

Either of these manual approaches are fast and easy, but if you routinely have to delete duplicate values from a column, a macro may be more your style. The following macro relies on data filtering, much like the earlier manual method:

Sub CreateUniqueList()
    Dim rData As Range
    Dim rTemp As Range

    Set rData = Range(Range("a1"), Range("A1048576").End(xlUp))
    rData.EntireColumn.Insert
    Set rTemp = rData.Offset(0, -1)
    rData.AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=rTemp, _
        Unique:=True

    rTemp.EntireColumn.Copy _
        rData.EntireColumn
    Application.CutCopyMode = False
    rTemp.EntireColumn.Delete
    Set rData = Nothing
    Set rTemp = Nothing
End Sub

The macro creates a temporary column, uses advanced filtering to copy the unique values to that column, then deletes the original data column. The result is just unique values in column A. If you don't want your macro to use the data filtering feature of Excel, then the following macro will do the trick:

Sub DelDups()
    Dim rngSrc As Range
    Dim NumRows As Integer
    Dim ThisRow As Integer
    Dim ThatRow As Integer
    Dim ThisCol As Integer
    Dim J As Integer, K As Integer

    Application.ScreenUpdating = False
    Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)

    NumRows = rngSrc.Rows.Count
    ThisRow = rngSrc.Row
    ThatRow = ThisRow + NumRows - 1
    ThisCol = rngSrc.Column

    'Start wiping out duplicates
    For J = ThisRow To (ThatRow - 1)
        If Cells(J, ThisCol) > "" Then
            For K = (J + 1) To ThatRow
                If Cells(J, ThisCol) = Cells(K, ThisCol) Then
                    Cells(K, ThisCol) = ""
                End If
            Next K
        End If
    Next J

    'Remove cells that are empty
    For J = ThatRow To ThisRow Step -1
        If Cells(J, ThisCol) = "" Then
            Cells(J, ThisCol).Delete xlShiftUp
        End If
    Next J
    Application.ScreenUpdating = True
End Sub

The macro works on a selection you make before calling it. Thus, if you need to remove duplicate cells from the range A2:A974, simply select that range and then run the macro. When the macro is complete, the duplicate cells are removed, as are any blank cells.

ExcelTips is your source for cost-effective Microsoft Excel training. This tip (12711) applies to Microsoft Excel 2007, 2010, and 2013. You can find a version of this tip for the older menu interface of Excel here: Deleting Duplicate Text Values.

Author Bio

Allen Wyatt

With more than 50 non-fiction books and numerous magazine articles to his credit, Allen Wyatt is an internationally recognized author. He  is president of Sharon Parq Associates, a computer and publishing services company. ...

MORE FROM ALLEN

Messed-up Typing

It is not uncommon for newcomers to Word to overwrite their existing document text as they are editing. There is a reason for ...

Discover More

Transposing Two Characters

If you have two characters in the wrong order, you might be interested in a shortcut you can use to switch their order. There ...

Discover More

Inadvertantly Getting Rid of Frozen Panes

Excel provides quite a bit of flexibility in displaying your data. You can have multiple windows visible for the same ...

Discover More

Program Successfully in Excel! John Walkenbach's name is synonymous with excellence in deciphering complex technical topics. With this comprehensive guide, "Mr. Spreadsheet" shows how to maximize your Excel experience using professional spreadsheet application development tips from his own personal bookshelf. Check out Excel 2013 Power Programming with VBA today!

More ExcelTips (ribbon)

Identifying Digit-Only Part Numbers Excluding Special Characters

When working with data in Excel, you often need to determine if that data meets criteria that you specify. This tip examines ...

Discover More

Determining Winners, by Category

Do you need to determine the top three values in a range of columns? The techniques discussed in this tip will come in ...

Discover More

Concatenating Values from a Variable Number of Cells

Excel makes it easy to concatenate (or combine) different values into a single cell. If you need to combine a different ...

Discover More
Subscribe

FREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."

View most recent newsletter.

Comments

If you would like to add an image to your comment (not an avatar, but an image to help in making the point of your comment), include the characters [{fig}] in your comment text. You’ll be prompted to upload your image when you submit the comment. Maximum image size is 6Mpixels. Images larger than 600px wide or 1000px tall will be reduced. Up to three images may be included in a comment. All images are subject to review. Commenting privileges may be curtailed if inappropriate images are posted.

What is 3 + 8?

2016-08-19 13:39:25

Scott Renz

I often need to remove duplicates with a VBA macro. This comes about in cases where I copy data from two sheets into one and some rows may be identical in both sheets.

I used to find it frustrating to have to make the Columns:=Array(1, 2, 3, etc. part. Especially where there were a lot of columns. I discovered a way to automatically make the array and not have to know the number of columns as illustrated below:

Sub RemoveDups()
Dim MyArray As Variant
Dim LastCol As Long
Dim LastRow As Long
Dim I As Long
Dim FirstRow As Long

ActiveSheet.UsedRange
LastRow = Cells.SpecialCells(xlLastCell).Row
LastCol = Cells.SpecialCells(xlLastCell).Column
ReDim MyArray(0 To LastCol - 1)

For I = 1 To LastCol
MyArray(I - 1) = I
Next I
FirstRow = InputBox("Enter the row number of the header row?")

ActiveSheet.Range(Cells(FirstRow, 1), Cells(LastRow, LastCol)).UnMerge
ActiveSheet.Range(Cells(FirstRow, 1), Cells(LastRow, LastCol)).RemoveDuplicates Columns:=(MyArray), Header:=xlYes
ActiveSheet.UsedRange

End Sub


2015-09-28 13:19:43

Sara

Hi there.

I wonder if you can help?

How can I change the column in which this VBA relates to (I've tried changing 'A:A' to 'B:B' to no avail!)


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 And Len(Target.Value) > 0 Then

If Evaluate("Countif(A:A," & Target.Address & ")") > 1 Then
MsgBox Target.Value & " is a duplicate entry. It will be removed.", vbExclamation, "Data Entry Editor"
Range(Target.Address).ClearContents

End If

End If

End Sub


Any help would be greatly appreciated...

Many thanks,
Sara


2014-01-03 05:11:59

Shreepad S M Gandhi

@Michael (Micky) Avidan

Referred the image at the address specified by you. Thank you very much.


2014-01-02 10:48:00

Michael (Micky) Avidan

@Shreepad,
In order to only color the duplicate (from the second one and up) you don't need any helper-column (col. B un your suggestion).

All you need is to define "Conditionla Format" DIRECTLY on the data cells of col. "A".

Have a look at the following link:
http://jpg.co.il/download/52c5899b1481e.png

Michael (Micky) Avidan
“Microsoft® Answers" - Wiki author & Forums Moderator
“Microsoft®” MVP – Excel (2009-2014)
ISRAEL


2014-01-02 04:19:21

Shreepad S M Gandhi

Many a times you need to not delete the duplicate values but just color these cells. This is a workaround to achieve it:

Suppose A1 and B1 are headers and
Range A2:A11 contains your data:

Step 1 : In cell B2, Type the formula
=COUNTIF($A$2:$A$11,A2)

Step 2 : Drag it till B11

Based on the repeatations, you will get to see the results, say 1 for 1 appearance, 2 for 2 appearances.

Step 3 : Go To Home menu, Click Conditional Formatting, Manage Rules, Select New Rule, Choose Format only cells that contain...
1st dropdown at bottom - Choose Cell Value
Choose Greater than in next dropdown
Type 1 in next box

Step 4 : Choose the Format (say for example Fill color as Red, Then Choose OK.
You will get back to a Dialog box titled "Conditional Formatting Rules Manager". In the applies to box give the range you want this conditional formatting to be worked onto...say in our case that would have been =$B$2:$B$11

Step 5 : OK

And you will see all the duplicate entries colored.

Now you may manage this data further to suit your requirement.


2013-11-11 08:22:25

Bryan

John, thanks for that little nugget of common sense; there is some serious overengineering going on here. I remove duplicates all the time, and I added the function to my QAT. I have never needed a macro to remove duplicates.


2013-11-11 06:51:32

John Lee

Or just select the data from which duplicates should be removed, and click the 'Remove duplicates' button on the 'Data' tab.


2013-11-09 17:25:56

Thomas Papavasiliou

For the same purpose and eliminating the need of sorting the data, I wrote a macro that runs extremely fast elimination all double or multiple occurrences keeping the last one.

The macro may seem long but it is very flexible and fast. In case anybody is interested here it is:

Sub Fast_double_eraser()

'Macro written 23/02/2002 by Thomas Papavasiliou.

With Application
.ScreenUpdating = True
.StatusBar = False
.DisplayAlerts = True
End With

On Error GoTo errorhandling

'Defining variables.
Dim msg, msg1, ans, ad1, s_sh, o_n, ad2, n_n, co_le As String
Dim C, sc, ec, sc1, ec1, kc As Integer
Dim r, sr, er, t, sr1, er1, fr1, c_e, f_e, e_e, id_rows, mr As Long
Dim cell As Variant

'Preparing the Introduction message, displaying the message and controlling chosen answer.
msg = "This macro will erase all but the last occurrence of identical key cell rows." & Chr(13)
msg = msg & "Search starts from selection and goes downwards." & Chr(13)
msg = msg & "Process is case sensitive." & Chr(13)
msg = msg & "Macro counts empty or error cells , but ignores them leaving them in their positions." & Chr(13) & Chr(13)
msg = msg & "Do you want to continue ?" & Chr(13)

ans = MsgBox(msg, vbYesNo + vbQuestion, "Please make a choise")
If ans = 7 Then
Exit Sub
End If
s_sh = ActiveSheet.Name 'Original sheet's name.

'Autofilter mode control
If ActiveSheet.AutoFilterMode = True Then
msg = "Auto Filter mode is on. Do you want to continue "
ans = MsgBox(msg, vbYesNo + vbQuestion)
If ans = 7 Then
Exit Sub
End If
End If

'Input message preparation, input dialog and controls.
msg = "Select the top data cell on the key column"

On Error Resume Next
ad1 = Application.InputBox(msg, Default:=ActiveCell.Address, Title:="Select a single cell", Type:=8).Address
If Err Then MsgBox "Cancel selected, macro ends. ", vbOKOnly + vbExclamation: Exit Sub
On Error GoTo errorhandling

Range(ad1).Select

With Range(ad1)
r = .Row
C = .Column
If .Rows.Count * .Columns.Count > 1 Then 'Unique cell selection control.
msg = "Selection points to multiple cells. Macro stops."
MsgBox msg, vbOKOnly + vbExclamation
Exit Sub
End If
End With

With Range(ad1).CurrentRegion
sr = .Row
sc = .Column
er = .Rows.Count + sr - 1
ec = .Columns.Count + sc - 1
If .Cells.Count = 1 Then 'Non significant area selection control.
msg = "Selection points to an empty area. Macro stops."
MsgBox msg, vbOKOnly + vbExclamation
Exit Sub
End If
End With
'End of preliminary controls.

t = Time 'Starting time counter.

Application.ScreenUpdating = False

'Getting chosen column letter for messaging
co_le = Mid(ad1, InStr(ad1, "$") + 1, InStr(2, ad1, "$") - 2)

'Copying data to a new sheet.
' Sheets(ActiveSheet.Name).Copy before:=Sheets(ActiveSheet.Name) 'New sheet that will hold the results.
Sheets.Add After:=ActiveSheet
o_n = ActiveSheet.Name
Sheets(s_sh).Cells.Copy Destination:=Sheets(o_n).Range("a1")

ad2 = Range(Cells(r, sc), Cells(er, ec)).Address

'Copying data to process cells defined as ad2 to a new temporary sheet.
Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count) 'Temporary sheet to process data.
n_n = ActiveSheet.Name
Sheets(o_n).Range(ad2).Copy Destination:=Sheets(n_n).Range("c1")

'Performing actions on this new sheet.
With Range("c2").CurrentRegion
sr1 = .Row
sc1 = .Column
er1 = .Rows.Count + sr1 - 1
ec1 = .Columns.Count + sc1 - 1
End With

'Inserting series of numbers for final re-sorting
Cells(1, 2) = 1
Range(Cells(1, 2), Cells(er1, 2)).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1

kc = C - sc + 3 'Key column on n_n sheet.

'Sorting to key cell
Range("c1").CurrentRegion.Sort key1:=Cells(1, kc), order1:=xlDescending, header:=xlNo

'Filling a criteria.
For Each cell In Range(Cells(1, kc), Cells(er1, kc))
If IsError(cell) = True Then
Cells(cell.Row, 1) = 1
ElseIf IsEmpty(cell) = True Then
Cells(cell.Row, 1) = 1
ElseIf cell <> cell.Offset(1, 0) Then
Cells(cell.Row, 1) = 1
End If
Next cell

Range("a1").CurrentRegion.Sort key1:=Cells(1, 1), order1:=xlDescending, header:=xlNo

'Counting constant errors, formula errors and empty cells.
On Error Resume Next
c_e = 0
f_e = 0
e_e = 0

With Columns(kc)
c_e = .SpecialCells(xlCellTypeConstants, 16).Count
f_e = .SpecialCells(xlCellTypeFormulas, 16).Count
e_e = .SpecialCells(xlCellTypeBlanks).Count
End With

On Error GoTo errorhandling

'Forming the common part of ending messages.
msg1 = "Checked part of key column contains:" & Chr(13)
msg1 = msg1 & c_e & " constant errors" & Chr(13)
msg1 = msg1 & f_e & " formula errors" & Chr(13)
msg1 = msg1 & e_e & " empty cells" & Chr(13) & Chr(13)
msg1 = msg1 & "Thank you for using our macro"

'Counting the rows to clear, to detect unique key cells and providing data for the ending message information.
id_rows = Range("a1").End(xlDown).Row
Range(Cells(id_rows + 1, 1), Cells(er1, ec1)).EntireRow.Delete

'All cells are unique. No doubles.
If id_rows = er1 Then
msg = "On this run and for " & Format(Time - t, "hh:mm:ss") & " hh:mm:ss, "
msg = msg & "macro checked " & er - r + 1 & " data rows. " & Chr(13)
msg = msg & "and did not encounter any identical rows on the key cell column" & Chr(13) & Chr(13)

With Application
.DisplayAlerts = False
Sheets(n_n).Delete
Sheets(o_n).Delete
.StatusBar = False
.DisplayAlerts = True
.ScreenUpdating = True
End With

Sheets(s_sh).Activate
Cells(r, C).Select
MsgBox msg & msg1, vbOKOnly + vbInformation, "Checked column = " & co_le
Exit Sub
End If

'Re-sorting remaining data to it's original order.
Cells.Sort key1:=Columns(2), order1:=xlAscending, header:=xlNo

'All identical case ending procedure.
If Application.WorksheetFunction.Subtotal(3, Columns(1)) = 2 Then
msg = "On this run and for " & Format(Time - t, "hh:mm:ss") & " hh:mm:ss, "
msg = msg & "macro checked " & er - r + 1 & " data rows. " & Chr(13)
msg = msg & "Key cells in all checked data rows are identical" & Chr(13) & Chr(13)

With Application
.DisplayAlerts = False
Sheets(n_n).Delete
Sheets(o_n).Delete
.StatusBar = False
.DisplayAlerts = True
.ScreenUpdating = True
End With

Sheets(s_sh).Activate
Cells(r, C).Select
MsgBox msg & msg1, vbOKOnly + vbInformation, "Checked column = " & co_le
Exit Sub
End If

'Erasing columns A and B.
Columns("a:b").Delete

'Transferring back the processed data to o_n named sheet.
Sheets(o_n).Range(ad2).Clear
Sheets(n_n).Range("a1").CurrentRegion.Copy Destination:=Sheets(o_n).Cells(r, sc)
Sheets(o_n).Activate
' Cells(r, sc).PasteSpecial Paste:=xlAll
Range(ad1).Select

'Indicating the source file and column.
mr = Range(ad1).CurrentRegion.Row + Range(ad1).CurrentRegion.Rows.Count
Cells(mr + 1, sc) = "Derived from sheet """ & s_sh & """ after erasing all but the last of double or multiples occurrences, according to key in column """ & co_le & """ starting from row """ & r & """ of the source sheet"

'Preparing end message.
msg = "On this run and for " & Format(Time - t, "hh:mm:ss") & " hh:mm:ss, "
msg = msg & "macro checked " & er - r + 1 & " data rows. " & Chr(13)
msg = msg & "It erased " & er1 - id_rows & " rows, keeping the last of each double or multiple occurrence " & Chr(13) & Chr(13)
msg = msg & "Results display on sheet """ & o_n & """ and contains " & (er - r + 1) - (er1 - id_rows) & " date rows" & Chr(13) & Chr(13)
msg = msg & "Original data remains intact in sheet """ & s_sh & """" & Chr(13) & Chr(13)

With Application
.DisplayAlerts = False
Sheets(n_n).Delete
.StatusBar = False
.DisplayAlerts = True
.ScreenUpdating = True
End With

Sheets(o_n).Activate
Cells(r, C).Select
MsgBox msg & msg1, vbOKOnly + vbInformation, "Please read the message"
Exit Sub

errorhandling:
With Application
.StatusBar = False
.ScreenUpdating = True
.DisplayAlerts = False
Sheets(n_n).Delete
Sheets(o_n).Delete
.DisplayAlerts = True
End With

msg = "Macro encounters an unexpected error." & Chr(13)
msg = msg + "Please try to re-run the macro controlling original data validity" & Chr$(13)
msg = msg + "If the error persists, contact the programmer" & Chr$(13) & Chr$(13)
msg = msg + "Thomas Papavasiliou." & Chr$(13)
msg = msg + "e-mail thpapavasiliou@yahoo.com"
MsgBox msg, vbOKOnly + vbCritical

End Sub


2013-11-09 05:36:07

Michael (Micky) Avidan

In order to copy the unique(!) values to another location which one specifies - there is a "simple" Array Formula approach as illustrated in the linked picture:

http://srv1.jpg.co.il/9/527e0f739d7a2.png

Michael (Micky) Avidan
“Microsoft® Answers" - Wiki author & Forums Moderator
“Microsoft®” MVP – Excel (2009-2014)
ISRAEL



This Site

Got a version of Excel that uses the ribbon interface (Excel 2007 or later)? This site is for you! If you use an earlier version of Excel, visit our ExcelTips site focusing on the menu interface.

Newest Tips
Subscribe

FREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."

(Your e-mail address is not shared with anyone, ever.)

View the most recent newsletter.