Delete Duplicate Rows Excel

[ericwill43]

Is there a way to use excel to remove duplicate repeating rows where one column=another column that is not in the same row?

Example
Date Team1 Team2
3/7/08 tigers wildcats
3/8/08 tigers broncos
3/9/08 tigers mustangs
3/7/08 wildcats tigers
3/8/08 wildcats mavericks
3/9/08 wildcats broncos

The row to be deleted would be the 3/7/08 wildcats tigers!

 

[BrianB]

I think this is what you want

'=============================================================================
'- CHECK CONTENTS OF COLUMN A FOR CROSS MATCH IN COLUMN B DELETE MATCHING ROWS
'- Brian Baulsom April 2009
'=============================================================================
Sub test()
    Dim MyRow As Long
    Dim MyTeam As String
    Dim MyOpponent As String
    Dim LastRow As Long
    Dim FoundCell As Range
    Dim Counter As Integer
    '-------------------------------------------------------------------------
    LastRow = Range("A65536").End(xlUp).Row
    Counter = 0
    '-------------------------------------------------------------------------
    '- CHECK EACH ROW COLUMN A until empty cell found
    MyRow = 2
    While Cells(MyRow, 2).Value <> ""
        Application.StatusBar = MyRow
        MyTeam = Cells(MyRow, 2).Value
        MyOpponent = Cells(MyRow, 3).Value
        '---------------------------------------------------------------------
        '- FIND MATCHING VALUE IN COLUMN B
        Set FoundCell = Columns("C:C").Find(What:=MyTeam, After:=[c1], _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
        '---------------------------------------------------------------------
        '- IF MATCH FOUND - CHECK OPPONENT. DELETE THE ROW
        If Not FoundCell Is Nothing Then
            If Cells(FoundCell.Row, 2).Value = MyOpponent Then
                FoundCell.EntireRow.Delete
                LastRow = LastRow - 1
                Counter = Counter + 1
            End If
        End If
        '---------------------------------------------------------------------
        MyRow = MyRow + 1
    Wend
    '-------------------------------------------------------------------------
    MsgBox ("Deleted " & Counter & " rows.")
End Sub
'=============================================================================

 

[Wayne01]

Hi Brian

I tested your code and it works fine. However, it might be a good idea if it was modified a little to also capture duplicates where the values in columns A, B and C are the same (see below):

Date Team1 Team2
3/7/08 tigers wildcats
3/8/08 tigers broncos
3/9/08 tigers mustangs
3/7/08 wildcats tigers
3/8/08 wildcats mavericks
3/9/08 wildcats broncos
3/8/08 wildcats mavericks

In the above table, the second instance of "3/8/08 wildcats mavericks" should also be removed.

If I could suggest a modification, I would. Regrettably I can't. Someone else might like to have a crack at this one as it's a nice piece of code and could be made a little more functional.

Regards

Wayne

 

[BrianB]

The original code was an interesting puzzle because it is different to your latest query which is the more standard requirement to remove duplicate rows - or at least that is what it seems, depending on your data content.

There are several methods of dealing with this in code. In this case I would use a temporary column eg. insert a column A to save changing the following code - with formula =A2+B2+C2. This creates unique values which can be used with something like my code here :-

http://www.mrexcel.com/forum/showthread.php?t=131509

 

[Wayne01]

Hi Brian

Yes I can imagine it was a puzzel to figure out. But it is such a great piece of code that is doing exactly what was required. However, I can imagine that there would be times when a normal duplication might arise where the data in each of the three cells will be identical. Unfortunately, your code would not have picked up such a duplication.

I have tried your alternative code on the list used in this thread but it fails on the sort and gives me an error message for some reason. I will try it again on another list later. But even if it does work, as I'm sure it would, it would not pick up the type of duplication originally noted by the Author of this thread as "3/7/08&tigers&wildcats" and "3/7/08&wildcats&tigers" are both unique yet still represent a duplication.

So some modification of your original code to pick up both types of duplications would be very useful.

I do have a use for such a code although at the moment I'm simply using code that calls excel's advanced filter which is doing the job. Your original code with this suggested treak would, I think, be better.

Thanks for your time and efforts Brian.

Kind regards

Wayne

 

[Legacy 14611]

Perhaps this could satisfy everyone:

Sub duplik()
Dim a, b As Range, c(), n As Long, m As Integer
Dim x, j As Integer, p As Long
a = ActiveSheet.UsedRange
n = UBound(a, 1): m = UBound(a, 2)
ReDim c(1 To n - 1, 1 To m)
Set b = ActiveSheet.UsedRange.Resize(n - 1).Offset(1)
With CreateObject("Scripting.Dictionary")
For i = 1 To n - 1
    x = Empty
    b.Rows(i).Sort b(i, 2), Orientation:=xlLeftToRight
    For j = 1 To m: x = x & Chr(30) & b(i, j): Next j
    If Not .exists(x) Then
        .Add x, Empty
        p = p + 1
        For j = 1 To m: c(p, j) = a(i + 1, j): Next j
    End If
Next i
End With
b.ClearContents
b(1, 1).Resize(p, m) = c
End Sub

 

[Wayne01]

Hi rugila

Yep, that will do it. And as always, a fine piece of work. Well done.

I'm sure ericwill43 be pleased.

If anyone stumbles upon this post, be sure to save this code to your "It might just come in handy one day" folder because it probably will.

Thanks again rugila. And thanks Brian.

Cheers.

Wayne