ericwill43

New Member
Joined
Apr 20, 2009
Messages
4
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!
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
I think this is what you want
Code:
'=============================================================================
'- 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
'=============================================================================
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Perhaps this could satisfy everyone:
Code:
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top