Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 161
  • Last Modified:

Delete duplicate row based on 2 cells criteria

Hi all,

I have an excel sheet (just like the below where I have some rows that have the same data in column A("Old") and B("New"). I would like for it to keep the first instance of an identical row and delete whenever else there is a duplicate where teh values in both columns had an exact replica in a previous row. I can't seem to find it on any search engines. For clarity, i have added in te table below a note at the ned of each row of which rows to keep and which to delete. The actual data I wish to process is over 45,000 lines so a sumproduct is out of teh question as it completely blocks my PC each time it updates.

i am using Excel 2007 and have some knowledge of VBA.

Old       New      
1AB      645      Keep
1AB      645      Delete
1AB      654      Keep
1AB      654      Delete
2AD      456      Keep
2AD      456      Delete
2AD      546      Keep
2AD      546      Delete

0
touyets17
Asked:
touyets17
  • 2
  • 2
1 Solution
 
SiddharthRoutCommented:
>>>i am using Excel 2007 and have some knowledge of VBA.

You don't need VBA For this.

Click on Data Tab ~~> Remove duplicates and the select the relevant columns :)

Sid
0
 
SiddharthRoutCommented:
If you still like a macro then use this. Please amend as applicable. :)

Sub Sample()
    Dim LastRow As Long
    
    LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    Sheets("Sheet1").Range("$A$1:$C$" & LastRow).RemoveDuplicates _
    Columns:=Array(1, 2), Header:=xlYes
End Sub

Open in new window


Sid
0
 
dlmilleCommented:
This code will remove all but the first instance of duplicates...

Assumes the data is in columns A:B, and the first row is a header...


Here's the code:

 
Sub keepOnlyFirst()
Dim myCell As Range, tmpRng As Range
Dim testVal1 As String, testVal2 As String
Dim i As Long, lastRow As Long

    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    i = 2
    Do
        Set myCell = Cells(i, 1)
        If myCell.Value = testVal1 And myCell.Offset(0, 1).Value = testVal2 Then 'check Old and New for duplicates
            myCell.EntireRow.Delete
            i = i - 1
            lastRow = lastRow - 1
        Else
            testVal1 = myCell.Value
            testVal2 = myCell.Offset(0, 1).Value
        End If
        i = i + 1
    Loop Until i > lastRow
    
End Sub

Open in new window


See attached spreadsheet demonstration.

Enjoy!

Dave
EliminateDups-r2.xls
0
 
dlmilleCommented:
Sid - very nice!

Dave
0
 
touyets17Author Commented:
Exquisite!
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

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