How to use macro examples to delete duplicate items in a list in Excel

Support for Office 2003 has ended

Microsoft ended support for Office 2003 on April 8, 2014. This change has affected your software updates and security options. Learn what this means for you and how to stay protected.

This article was previously published under Q291320
MORE INFORMATION
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.

Sample 1: Delete duplicate items in a single list

The following sample macro searches a single list in the range A1:A100 and deletes all duplicate items in the list. This macro requires that you do not have empty cells in the list range. If your list does contain empty cells, sort the data in ascending order so that the empty cells are all at the end of your list. 
Sub DelDups_OneList()Dim iListCount As IntegerDim iCtr As Integer' Turn off screen updating to speed up macro.Application.ScreenUpdating = False' Get count of records to search through.iListCount = Sheets("Sheet1").Range("A1:A100").Rows.CountSheets("Sheet1").Range("A1").Select' Loop until end of records.Do Until ActiveCell = ""   ' Loop through records.   For iCtr = 1 To iListCount      ' Don't compare against yourself.      ' To specify a different column, change 1 to the column number.      If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then         ' Do comparison of next record.         If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then            ' If match is true then delete row.            Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp               ' Increment counter to account for deleted row.               iCtr = iCtr + 1         End If      End If   Next iCtr   ' Go to next record.   ActiveCell.Offset(1, 0).SelectLoopApplication.ScreenUpdating = TrueMsgBox "Done!"End Sub				

Sample 2: Compare two lists and delete duplicate items

The following sample macro compares one (master) list against another list, and deletes duplicate items in the second list that are also in the master list. The first list is on Sheet1 in the range A1:A10. The second list is on Sheet2 in the range A1:A100. To use the macro, select either sheet, and then run the macro. 
Sub DelDups_TwoLists()Dim iListCount As IntegerDim iCtr As Integer' Turn off screen updating to speed up macro.Application.ScreenUpdating = False' Get count of records to search through (list that will be deleted).iListCount = Sheets("sheet2").Range("A1:A100").Rows.Count' Loop through the "master" list.For Each x In Sheets("Sheet1").Range("A1:A10")   ' Loop through all records in the second list.   For iCtr = 1 To iListCount      ' Do comparison of next record.      ' To specify a different column, change 1 to the column number.      If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then         ' If match is true then delete row.         Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp         ' Increment counter to account for deleted row.         iCtr = iCtr + 1      End If   Next iCtrNextApplication.ScreenUpdating = TrueMsgBox "Done!"End Sub				
REFERENCES
For more information about how to use the sample code in this article, click the article number below to view the article in the Microsoft Knowledge Base:
290140 How to run sample code from Knowledge Base articles
dups inf XL2002 XL2003 XL2007 XL2010
Properties

Article ID: 291320 - Last Review: 09/18/2011 22:59:00 - Revision: 6.0

Microsoft Office Excel 2007, Microsoft Excel 2002 Standard Edition, Microsoft Office Excel 2003, Microsoft Excel 2010

  • kbautomation kbprogramming kbmacro kbdtacode kbhowto KB291320
Feedback