#1
|
|||
|
|||
Compare two lists and delete rows that are NOT the same
I pulled this code from a youtube video and it compares two lists and removes duplicates from one of them. However I would like to change the code so it removes non-duplicates. Here is the code: Code:
Sub RemoveDupsBetweenLists() Dim sht1 As Worksheet Dim sht2 As Worksheet Dim C1row As Long Dim C2row As Long Dim C2TotalRows As Long Dim CustID As String Dim NoDups As Long Set sht1 = Worksheets("Customers 1") Set sht2 = Worksheets("Customers 2") sht2.Activate C2TotalRows = Application.CountA(Range("A:A")) C1row = 2 Do While sht1.Cells(C1row, 2).Value <> "" CustID = sht1.Cells(C1row, 2).Value For C2row = 2 To C2TotalRows If CustID = Cells(C2row, 2).Value Then sht1.Activate Rows(C1row).Delete NoDups = NoDups + 1 C1row = C1row - 1 sht2.Activate Exit For End If Next C1row = C1row + 1 Loop MsgBox NoDups & " Duplicates were removed" End Sub Code:
If CustID = Cells(C2row, 2).Value Then Code:
If CustID <> Cells(C2row, 2).Value Then |
#2
|
|||
|
|||
If you have your sht1 showing full screen, then show the VBA environment full screen and hit the Windows Key and Right Arrow Key at the same time, your screen should then be half and half so you can use the F8 key to step one line at a time through your code and watch what happens with the spreadsheet as each line is executed.
I think you'll find that as you deal with each cell of the outer loop (the Do While), the For C2row = 2 to C2TotalRows (inner loop) IF statement will be TRUE at C2row = 2 for all but one value, which will then be TRUE when C2row = 3, so every value from the outer loop will be deleted. Would be simpler to use range.FIND to see if the values of one list exist in the other. Would also eliminate the inner loop. When deleting rows it's easiest to work from the bottom up. Sheets and ranges can be referenced directly in code to eliminate activating sheets back and forth. See if this works for you Code:
Sub Removal_of_NonDups() Dim sht1 As Worksheet, sht2 As Worksheet Dim Lastrow As Long, i As Long, NumRemoved As Long Dim rng As Range, fndRng As Range Set sht1 = Worksheets("Customers 1") Set sht2 = Worksheets("Customers 2") With sht2 Set rng = .Range("B2", .Cells(Rows.Count, "B").End(xlUp)) End With With sht1 Lastrow = .Cells(Rows.Count, "B").End(xlUp).Row For i = Lastrow To 2 Step -1 Set fndRng = rng.Find(What:=.Cells(i, 2).Value, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If fndRng Is Nothing Then 'was not found .Rows(i).Delete NumRemoved = NumRemoved + 1 End If Next i End With MsgBox NumRemoved & " Non-Duplictes were removed." End Sub |
#3
|
|||
|
|||
NoSparks
Holy Macro! (See what I did there) It does exactly what it needs to. Good to know about starting at the bottom and going back and forth sheet to sheet. Will run much quicker. Clearly the VBA Gods have sent you. Thank you so much. |
#4
|
|||
|
|||
NoSparks,
I would now like to create another program but that does what this code originally was made to do......delete rows if data is the same. I would use the original code I received but yours is so much better. I believe all that needs to change is to add a "Not" so the code is: Code:
If Not fndRng Is Nothing Then 'was not found |
#5
|
|||
|
|||
Correct, but change the comment.
|
Tags |
compare documents, delete duplicates |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
delete custom lists macro | ewso | Excel Programming | 13 | 10-12-2017 07:39 AM |
frustrating beyond belief!: trying to compare two lists of URLs | cachaco | Excel | 2 | 08-25-2015 08:10 AM |
Delete blank rows between the two rows that contain data | beginner | Excel Programming | 5 | 12-26-2014 12:29 AM |
Delete All empty Rows - Print - Undo all Rows deleted | Bathroth | Word VBA | 1 | 10-01-2014 01:40 PM |
Conditional Formatting to compare lists and order | SarahBear | Excel | 4 | 07-09-2014 09:40 AM |