Excel.Tips.Net Welcome toExcel.Tips.Net

Helpful Links

Tips.Net Home
ExcelTips Home
Ask an Excel Question
Make a Comment

Tips.Net Store

ExcelTips FAQ
ExcelTips Premium

Learn Access Now
Free Printable Forms

Beauty Tips
Car Tips
Cleaning Tips
College Tips
Cooking Tips
Excel2007 Tips
ExcelTips
Family Tips
Gardening Tips
Health Tips
Home Tips
Legal Tips
Money Tips
Organizing Tips
Pest Tips
Pet Tips
Wedding Tips
Word2007 Tips
WordTips

Advertise on the
ExcelTips Site

Newest Tips

Recording a Macro

Adding a Little Animation to Your Life

Converting a Range of URLs to Hyperlinks

Making the Formula Bar Persistent

Engineering Calculations

Digital Signatures for Macros

Fixing the Decimal Point

 

Removing Duplicate Cells

Summary: If you need to often delete duplicate items from a list, then you'll love the macro presented in this tip. It makes quick work out of removing all those duplicates. (This tip works with Microsoft Excel 97, Excel 2000, Excel 2002, Excel 2003, and Excel 2007.)

I can't tell you the number of times I have received raw data from some program or from some person, and the first thing I need to do is remove duplicates from the list. If you find yourself in the same situation, the following macro will be a huge help:

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 C15:C59, simply select that range and then run the macro. If you select more than a single column in the range (for instance, C15:E59), then only the first column in the range is affected. 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 (2109) applies to Microsoft Excel versions: 97 | 2000 | 2002 | 2003 | 2007

More Power! For some people, the prospect of creating macros can be scary. Those who conquer their fears, however, find they become much more confident and productive once they learn how to make Excel do exactly what they want. ExcelTips: The Macros is an invaluable source for learning Excel macros. You are introduced to the topic in bite-sized chunks, pulled from past issues of ExcelTips. Learn at your own pace, exactly the way you want.
 
Check out ExcelTips: The Macros today!