Removing Duplicate Rows based on 2 columns

**metalpoker** · 10-07-2011, 11:15 AM

Hi,

I have a database with around 8 columns for people who have entered a competition with the results ordered as such:

A = Name
B = email address
C, D, E = Various other fields
F = Postcode
G = Member (always contains either "Yes" or "No")

Because the same people will enter the competition over and over my databases downloaded from the website contain duplicates. If they are logged in as members the G column will automatically asign a yes or no depending on their status.

What I want to do is remove the duplicate rows based on whether both columns A and B (name and email) both match as this is how I am identifying unique people, NOT if the whole row matches (to avoid excluding people based on typos in addresses etc - name and email is accurate enough for what I need). I want the duplicate rows to be deleted in their entirety, preserving the A-G column structure for the uniques that remain.

This is the code I am using as found on an Excel resource website...

Sub RemoveDuplicateRecords()
    ' Local variables.
    Dim rngData         As Range, cell  As Range
    ' Set the data range based on email column.
    Set rngData = ActiveSheet.Range("B1", ActiveSheet.Range("B1").End(xlDown)).Offset(0, -1)
    ' Sort the table by name + email address.
    rngData.EntireRow.Sort Key1:=rngData.Range("A1").Offset(0, 1), Order1:=xlAscending, Key2:=rngData.Range("A1").Offset(0, 2), Order2:=xlAscending, Key3:=rngData.Range("A1").Offset(0, 0), Order3:=xlAscending
    ' Remove duplicate entries based on name + email as a duplicate.
    ' For speed purposes use clearcontents and then resort list
    For Each cell In rngData
    If cell.Offset(0, 1) = cell.Offset(1, 1) And cell.Offset(0, 2) = cell.Offset(1, 2) Then
    If cell.Offset(1, 0) = "" And cell.Offset(0, 0) <> "" Then cell.Offset(1, 0) = cell.Offset(0, 0)
    cell.EntireRow.ClearContents
    End If
    Next cell
    ' Sort the table alphabetically by name.
    rngData.EntireRow.Sort Key1:=rngData.Range("A1").Offset(0, 0), Order1:=xlAscending, Key2:=rngData.Range("A1").Offset(0, 1), Order2:=xlAscending
End Sub

--

The code above works but my problem is that sometimes people will enter a competition when they are logged in as a member, and then again when they are not logged in, and thus I get duplicates which are idential across name and email but has different Yes or No values in column G.

I thought the macro preserved the last entry in the list (deleting all duplicated before it) but I have noticed that one time it did not (which is how I discovered the Yes and No duplicate entries for someone).

Can someone please explain how to modify the code to make sure its as solid and reliable as possible, and can we add in something to say "if there are Yes and No values in column G for duplicated rows based on name and email, I want to keep the YES value in my summarised list once the macro has finished".

I hope that makes sense and that I have included everything needed for someone with more VBA experience than me to assist with!!

Susie x

**arlu1201** · 10-07-2011, 11:20 AM

First, please put your code within code tags.

2nd, please attach a workbook and we can help you out.

**NBVC** · 10-07-2011, 11:21 AM

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here

**arlu1201** · 10-07-2011, 11:50 AM

I have a solution ready for you. Once you comply with the rules, i can provide it to you.

**metalpoker** · 10-07-2011, 11:50 AM

Hi guys,

Apologies for not using code tags I just posted in a hurry

So I have attached a duplicate-test.xls file to my original post, which has some sample fictional data on it in the same format as my real spreadsheets. I have not saved this with the macro included though as thought it best to leave that off!

catherine paice, francis healey and wendy price all appear twice, so these duplicates need to go, however only columns A = name, B = email and G = Yes/No (for member) need to be considered. All the other data is copied across but as the macro should not compare address, city and phone it shouldnt matter what is inside these cells right?

What the macro should do is remove the duplicates based on both Name and Email together (which it does already) but if collective duplicates contain different Yes or No values in G, it needs to display Yes for that column in the final list.

Wendy Price is the one in the test file that has "yes" in one row and "no" in the other.

I hope that helps!!!

Susie x

**arlu1201** · 10-07-2011, 11:56 AM

Instead of going through your code, i found it easier (

) to do my own:



Sub remove_dups()

Dim lastrow As Long
Dim i As Long, j As Long

    Columns("A:G").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A:A"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B:B"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:G")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
lastrow = Range("A1").End(xlDown).Row

For i = 2 To lastrow

    If Range("A" & i).Value = Range("A" & i + 1).Value Then
    
        If Range("B" & i).Value = Range("B" & i + 1).Value Then
        
            If Range("G" & i).Value = "Yes" Then
                Rows(i + 1 & ":" & i + 1).Delete
            ElseIf Range("G" & i).Value = "No" Then
                Rows(i & ":" & i).Delete
            End If
            
            lastrow = lastrow - 1
            
        End If
    
    End If
                
Next

End Sub

I have tested it and it works. You can check it and let me know.

**metalpoker** · 10-07-2011, 12:10 PM

Many thanks for your reply!
I am getting an error message with this section of code highlighted:

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A:A"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

Also it will it work with just the active worksheet as I may chop and change where it is used?

**arlu1201** · 10-07-2011, 12:17 PM

Oops..ok the reason you got the error is because i use 2007 and u use 2003.

Replace

Columns("A:G").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A:A"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B:B"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:G")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

with

columns("A:G").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

If you have a predefined sheet, just replace "Sheet1" with the name of the sheet.

**metalpoker** · 10-07-2011, 12:39 PM

Hi,

Yes it works amazingly - thank you so much!! I thought I had it wrapped up with my original code but as it turned out I had not considered the Yes/No thing...

This now leads onto the next stage of this project which is more complex, so I'm going to post a new thread and will PM you the link as you might be able to help with that if you want something more challenging!!

Thanks again so much!!

Susie

**arlu1201** · 10-07-2011, 01:11 PM

Thank you so much.

Yes, i would surely be game for something more challenging.

Besides, if you found this post helpful, please rate it accordingly.

**metalpoker** · 10-07-2011, 01:25 PM

Hi arlu1201,

Just preparing a sample file for my next thread, but just in reference to this one is there a way of reducing the screen flicker while it removes the duplicates? The actual lists in question are on average 3000 - 5000 rows and even though it worked perfectly there was a lot of screen flicker?

Many thanks!

Ps - I added to your reputation - you really are an expert!!

**arlu1201** · 10-07-2011, 01:30 PM

Below

 Columns("A:G").Select
    Application.CutCopyMode = False

Just add this line:

Application.ScreenUpdating=False

At the end of the code, before End Sub, you can add

Application.ScreenUpdating=True

**metalpoker** · 10-07-2011, 01:55 PM

Hi,

I just noticed a problem with the remove_dups macro (see attached file) - when there are multiple listings for the same user, in this case Wendy Price who I have duplicated several more times with both Yes and No values under the VIP category.

After running the macro there are still a number of rows remaining with Wendy Price for both "yes" and "no"?

When the macro is finished I only want 1 row per unique person (based on name and email address combined) and thus Wendy Price would only remain once, and her listing should say "Yes" under the VIP row as she had at least one Yes in the original database before cleaning.

Not sure if I have broken it or if it needs fixing, so if you could have a look at it and run the test again with the new database I have attached I would really appreciate it!

Many thanks,

Susie x

**arlu1201** · 10-07-2011, 02:55 PM

I have tested it a bit but its still retaining several Wendy's. There should be a workaround. Let me look over it and give you an answer by tomorrow.

**arlu1201** · 10-08-2011, 07:29 AM

Hi,

I tried 2 more strategies but its getting all the more complicated. I tried using a count to count how many rows are there for one name and then proceed but that was not working properly.

Then i tried using autofilter but that too got complicated. Maybe we can bring in some experts to help us with this. What you can do is (since you have already marked this as closed, you may not get more replies from others), post your question again but this time you can provide the code that i gave and say that it takes care of the main deleting of duplicates, but when the records are more in number, the logic doesnt work. So you need their help to work around that small bit.

Sorry about this. I really tried a lot but couldn't think of anything to get it to work.

**arlu1201** · 10-10-2011, 05:12 AM

Hey,

I had a brain-wave last night on how i could solve your problem

.

Try this code:

[Sub remove_dups()

Dim lastrow As Long
Dim i As Long, j As Long

On Error GoTo errhandler

Columns("A:G").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
     , Order2:=xlAscending, key3:=Range("G2"), order3:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
     False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
     :=xlSortNormal
   
lastrow = Range("A1").End(xlDown).Row

For i = 2 To lastrow

    If Range("A" & i).Value = Range("A" & i + 1).Value Then
    
            If Range("G" & i).Value = "Yes" Then
            
                Rows(i + 1 & ":" & i + 1).Delete
                lastrow = lastrow - 1
                
            ElseIf Range("G" & i).Value = "No" Then
                
                Rows(i & ":" & i).Delete
                lastrow = lastrow - 1
                
            End If
            
            If Range("A" & i - 1) = Range("A" & i) And Range("A" & i) = Range("A" & i + 1) Then
            
                If Range("G" & i - 1).Value = "No" Then
                
                    Rows(i - 1 & ":" & i - 1).Delete
                    lastrow = lastrow - 1
                    
                ElseIf Range("G" & i - 1).Value = "Yes" Then
                    
                    Rows(i & ":" & i + 1).Delete
                    lastrow = lastrow - 2
                    i = i - 1
                    
                ElseIf Range("G" & i - 1 & ":" & "G" & i).Value = "No" Then
                    
                    i = i - 1
                    Rows(i - 1 & ":" & i).Delete
                    lastrow = lastrow - 2
                    
                End If
                    
        End If
    
    End If
    
    If Range("A" & i).Value <> "" And Range("A" & i + 1).Value = "" Then
    
        If Range("A" & i - 1) = Range("A" & i) Then
        
            If Range("G" & i - 1).Value = "Yes" Or Range("G" & i - 1).Value = "No" Then
            
                Rows(i & ":" & i).Delete
                lastrow = lastrow - 1
                                
            End If
            
        End If
        
    End If
                
Next

errhandler:
'MsgBox Err.Description

End Sub

**metalpoker** · 10-10-2011, 05:51 AM

hi arlu1201,

Thanks for the continued help, and don't worry about not being able to fix the issue I will repost the thread and see if I have more luck!

Many thanks!!

Susie

**arlu1201** · 10-10-2011, 05:54 AM

I did fix the issue Susie...see my today's post with the fresh code. Try it out and let me know if it works.

**metalpoker** · 10-10-2011, 06:29 AM

Originally Posted by arlu1201

I did fix the issue Susie...see my today's post with the fresh code. Try it out and let me know if it works.

Yeah sorry I just saw your post!!
My brain is all over the place...

I have tested your new code on the file I sent you and it seems to work, let me just test it something bigger as my real docs are like 4k rows long

Did you still want to take on the bigger challenge I now have if this works?

Susie

**arlu1201** · 10-10-2011, 06:32 AM

Yeah sure...just post it and let me try.

**metalpoker** · 10-10-2011, 06:54 AM

Ok so I have run a proper test now with a file containing about 5000 rows and what seems to be happening now is that I am getting 2 rows for each multiple user? They are both returning yes, which is correct, but it's still 2 rows when there should only be 1.

Any ideas?

I could then run the list through my original duplicate filter which would return the list I need, but I thought it best to see if we can resolve it properly?

I really do appreciate your help, I hope you don't mind the challenge I know its a tough cookie to crack and I would have NO IDEA how to do what you guys do!!

Susie

EDIT

Is it something to do with the length of the list? It worked fine on the test version but now with the super long lists its got this doubling issue? The orginals go through a cleaning process which puts them into the format seen in the example but the originals are not in alphatbetical order - not sure if that makes any difference?

**arlu1201** · 10-10-2011, 07:03 AM

I usually sort the list before i begin the calculations. You said both are "Yes", let me look through the code and see if i can add an additional condition.

**metalpoker** · 10-10-2011, 07:20 AM

Originally Posted by arlu1201

I usually sort the list before i begin the calculations. You said both are "Yes", let me look through the code and see if i can add an additional condition.

**arlu1201** · 10-10-2011, 07:12 AM

Try this out.

Sub remove_duplicates()

Dim lastrow As Long
Dim i As Long, j As Long

On Error GoTo errhandler

Columns("A:G").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
     , Order2:=xlAscending, key3:=Range("G2"), order3:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
     False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
     :=xlSortNormal
   
lastrow = Range("A1").End(xlDown).Row

For i = 2 To lastrow

    If Range("A" & i).Value = Range("A" & i + 1).Value Then
    
            If Range("G" & i).Value = "Yes" Then
            
                Rows(i + 1 & ":" & i + 1).Delete
                lastrow = lastrow - 1
                
            ElseIf Range("G" & i).Value = "No" Then
                
                Rows(i & ":" & i).Delete
                lastrow = lastrow - 1
                
            End If
            
            If Range("A" & i - 1) = Range("A" & i) And Range("A" & i) = Range("A" & i + 1) Then
            
                If Range("G" & i - 1).Value = "No" Then
                
                    Rows(i - 1 & ":" & i - 1).Delete
                    lastrow = lastrow - 1
                    
                ElseIf Range("G" & i - 1).Value = "Yes" Then
                    
                    Rows(i & ":" & i + 1).Delete
                    lastrow = lastrow - 2
                    i = i - 1
                    
                ElseIf Range("G" & i - 1).Value = "No" And Range("G" & i).Value = "No" Then
                    
                    i = i - 1
                    Rows(i - 1 & ":" & i).Delete
                    lastrow = lastrow - 2
                    
                ElseIf Range("G" & i - 1).Value = "Yes" And Range("G" & i).Value = "Yes" Then
                
                    Rows(i & ":" & i).Delete
                    lastrow = lastrow - 1
                    
                End If
                    
        End If
    
    End If
    
    If Range("A" & i).Value <> "" And Range("A" & i + 1).Value = "" Then
    
        If Range("A" & i - 1) = Range("A" & i) Then
        
            If Range("G" & i - 1).Value = "Yes" Or Range("G" & i - 1).Value = "No" Then
            
                Rows(i & ":" & i).Delete
                lastrow = lastrow - 1
                                
            End If
            
        End If
        
    End If
                
Next

errhandler:
'MsgBox Err.Description

End Sub

**arlu1201** · 10-10-2011, 07:26 AM

Try the code above and let me know.

**metalpoker** · 10-10-2011, 07:32 AM

Hi,

This is very strange, the first time I ran the code it worked, and now every time it still returns the duplicate Yes results on 2 rows - weird!!

Sorry about this, maybe Excel just doesnt like me lol!!

Susie

**arlu1201** · 10-10-2011, 07:49 AM

Can you run it again and let me know. Ensure you maintain a copy of the test data so you can just replace it when the code messes it up.

**metalpoker** · 10-10-2011, 07:57 AM

1st time I get the duplicates of the YES ones that have been filtered with your code..
2nd time these are removed and the list is as it should be!!

Just need to figure out why that doesnt happen all at once in the beginning??

**arlu1201** · 10-10-2011, 07:59 AM

Are you running the same dataset the 1st time and then replacing again when you run the 2nd time? Can you attach the whole file if possible, so i can test?

**metalpoker** · 10-10-2011, 08:06 AM

I'm running the macro twice on the same dataset, the first time I see duplicates, always 2 rows for the same "Yes" user if they were filtered due to the Yes/No condition in column G, then when I re-run it for a 2nd time those duplicates are removed to display the list perfectly as it should be.

I can't attach the whole file due to the sensitive information I'm afraid - sorry

Susie

EDIT

What I mean is I have to run the macro twice one after another on the same dataset to see the final result as it should be.

**abousetta** · 10-10-2011, 12:51 PM

Just as a heads-up.

lastrow = Range("A1").End(xlDown).Row

will only work correctly if there are no empty spaces or rows in Column A. Its generally better to use:

lastrow = Range("A" & Rows.Count).End(xlUp).Row

Since it goes to the last cell in Row A and moves up to the last non-empty row.

Hope this helps.

abousetta

**arlu1201** · 10-10-2011, 08:10 AM

Then since you are not replacing the dataset while running it the 2nd time, it means your macro still has the problem of the 2 "yes". Let me work something out.

**arlu1201** · 10-10-2011, 09:22 AM

I tried different stuff but still it doesnt remove them. In my case, i am getting one yes and one no. Maybe it will help if you can run the macro 2 times for now and in the meantime i will try and work something out.

Maybe i should get another brainwave like this one soon...

Maybe i need to sleep more to get them

**metalpoker** · 10-10-2011, 09:26 AM

Ok I will run them twice - many thanks and I look forward to your next brainwave

Many thanks

Susie

**metalpoker** · 10-10-2011, 12:18 PM

someone added this on another forum to ammend the code and make it work - just thought you'd like to see so you could find out what was causing the problem.

Thanks again for your help!! Susie

You have to loop backwards when deleting. Try like this (other changes to your code may be needed)

For i = lastrow To 3 Step -1
    If Range("A" & i).Value = Range("A" & i - 1).Value Then

**arlu1201** · 10-10-2011, 12:32 PM

Oh yeah....i actually didnt think of it. I am usually used to coding forwards. I will have to try out the code and see.

**arlu1201** · 10-14-2011, 02:10 AM

I have worked out the code starting from the last row up. Just try it out and let me know if this works:

Sub remove_dup()

Dim lastrow As Long
Dim i As Long, j As Long

On Error GoTo errhandler

Columns("A:G").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
     , Order2:=xlAscending, key3:=Range("G2"), order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
     False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
     :=xlSortNormal
   
lastrow = Range("A1").End(xlDown).Row

For i = lastrow To 2 Step -1

    If Range("A" & i).Value = Range("A" & i - 1).Value Then
    
        If Range("B" & i).Value = Range("B" & i - 1).Value Then
    
            If Range("G" & i).Value = "Yes" And Range("G" & i).Value <> "" Then
            
                Rows(i - 1 & ":" & i - 1).Delete
                lastrow = lastrow - 1
                
            ElseIf Range("G" & i).Value = "No" And Range("G" & i).Value <> "" Then
                
                Rows(i & ":" & i).Delete
                lastrow = lastrow - 1
                
            End If
        
        End If
            
    End If
                    
Next

errhandler:
'MsgBox Err.Description

End Sub

**abousetta** · 10-14-2011, 05:28 AM

Here's a shortened version that should run faster because it doesn't readjust the lastrow since it doesn't matter after the first loop:

Sub remove_dup()

Dim i As Long, j As Long, lastrow As Long

Columns("A:G").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
     , Order2:=xlAscending, key3:=Range("G2"), order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
     False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
     :=xlSortNormal
   
lastrow = Range("A" & Rows.Count).End(xlUp).Row

For i = lastrow To 2 Step -1
    If Range("A" & i) = Range("A" & i - 1) and Range("B" & i) = Range("B" & i - 1) and Range("G" & i) = "Yes" and Range("G" & i).Value <> "" Then 
        Rows(i - 1).Delete
    ElseIf Range("A" & i) = Range("A" & i - 1) and Range("B" & i) = Range("B" & i - 1) and Range("G" & i).Value = "No" And Range("G" & i).Value <> "" Then
        Rows(i).Delete
    End If     
Next

End Sub

Hope this helps.

abousetta

Removing Duplicate Rows based on 2 columns

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Re: Removing Duplicate Rows based on 2 columns

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions