• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 386
  • Last Modified:

VBA for Excel 2005 to delete duplicate rows

Hello,

I need some VBA code to remove duplicate ROWS, taking into account every column that makes up a row. In other words, values in Column A can be the same, values in Column A + Column B can be the same, and so on. What makes a record unique is Columns A + B + C + D + E.

My file will have a different number of records every month, so I will need the code to take that into account also.

Thanks.
0
erp1022
Asked:
erp1022
2 Solutions
 
wdosanjosCommented:
It should be something like this: (change to Header := xlYes if you have header rows)

ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4,5), Header:=xlNo

Open in new window


I hope this helps.
0
 
erp1022Author Commented:
When I added the above VBA to my spreadsheet and ran it, I get the attached error.
VBA-error.doc
0
 
wdosanjosCommented:
What version of Excel do you have?
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
erp1022Author Commented:
Office 2003
0
 
wdosanjosCommented:
OK. The previous code works for Excel 2007 / 2010.  Please try the following for Excel 2003: (It assumes 5 columns for evaluation, the worksheet is the ActiveSheet, and the data has no header row. If the data has headers, comment out all lines marked 'Header')

Sub RemoveDuplicates()
    Columns("H:L").Delete Shift:=xlToLeft
    
    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' Header
    
    Range("A1").FormulaR1C1 = "h1" ' Header
    Range("B1").FormulaR1C1 = "h2" ' Header
    Range("C1").FormulaR1C1 = "h3" ' Header
    Range("D1").FormulaR1C1 = "h4" ' Header
    Range("E1").FormulaR1C1 = "h5" ' Header
    
    ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1:L1"), Unique:=True
    
    Columns("A:G").Delete Shift:=xlToLeft
    
    Rows("1:1").Delete Shift:=xlUp ' Header
End Sub

Open in new window

0
 
erp1022Author Commented:
I have modified your code (see below) becuase my file has headers. When I run the macro,  am now getting a different error. See attached.

Sub RemoveDuplicates()
    Columns("H:L").Delete Shift:=xlToLeft
   
    '  Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' Header
   
    '  Range("A1").FormulaR1C1 = "h1" ' Header
    '  Range("B1").FormulaR1C1 = "h2" ' Header
    '  Range("C1").FormulaR1C1 = "h3" ' Header
    '  Range("D1").FormulaR1C1 = "h4" ' Header
    '  Range("E1").FormulaR1C1 = "h5" ' Header
   
    ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1:L1"), Unique:=True
   
    Columns("A:G").Delete Shift:=xlToLeft
   
    '  Rows("1:1").Delete Shift:=xlUp ' Header
End Sub



VBA-error-2.doc
0
 
wdosanjosCommented:
What line is causing the error?
0
 
erp1022Author Commented:
0
 
ElrondCTCommented:
wdosanjos clearly knows functions in Excel that I don't, but sometimes simpler may work better. I handle this kind of thing at a very basic level, which may not be quite as fast, but is probably more bullet-proof and easier to understand:
Sub DeleteDups()
    Range("A1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    RowEnd = Selection.Row
    ColEnd = Selection.Column
    For CurRow = RowEnd To 2 Step -1      ' Go backwards so deletes don't muck up pointer
        FoundDiff = False
        For CurCol = 1 To ColEnd
            If Cells(CurRow, CurCol) <> Cells(CurRow + 1, CurCol) Then
                FoundDiff = True
                Exit For
            End If
        Next CurCol
        If FoundDiff = False Then
            Rows(CurRow).Delete Shift:=xlUp
        End If
    Next CurRow

End Sub

Open in new window

Note that this won't get rid of duplicates that aren't next to each other. I'm assuming that's not a problem. If it is, you should sort the file before looking for duplicates.
0
 
aikimarkCommented:
0
 
rspahitzCommented:
I also like simple.

My suggestion is to start with a manual process using Excel, then record that process.  Unless you need speed or special situations, this is often an easy way to go.

So first I would go to column F and add a formula (starting in F2): =CONCATENATE(A2, B2, C2, D2, E2)
Copy this formula down to the end of the data.
(If the data is not sorted, then put column F in a different sheet then sort it)
Next, go to G2 and add this formula down to match column F: =IF(F2=F1,"","DUP")
Now go to G2 and turn on filtering. In the filter select those items with the word "DUP"
Select all rows of data.
Delete the rows.
Turn off the filter.

If you turned on the macro recorder just before the above steps, you now have your macro to handle the job.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now