Compare and find duplicates in 2 corresponding columns in 2 sheets

First things first, you have to figure out what your code is doing. You need to break your code up into little steps. Make sure each step makes sense and is done well. Then, you can start combining them in useful ways because it's clear what your code is doing and how.

Only then can you start really improving performance. Trying to do so before you have a clear idea of what your code is doing and how is a bad idea.

---

#1: Take your workbook/sheets and give them proper, descriptive names

Dim targetBook As Workbook Set targetBook = '/ whatever xlwb is With targetBook Dim resultsSheet As Worksheet Set resultsSheet = targetBook.Sheets("results") Dim masterSheet As Worksheet Set masterSheet = targetBook.Sheets("Master List") Dim followUpSheet As Worksheet Set followUpSheet = targetBook.Sheets("Follow Ups") End With 

---

#2: Find your end rows and put them in properly named variables

Dim resultsFinalRow As Long With resultsSheet resultsFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Dim masterFinalRow As Long With masterSheet masterFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Dim followUpFinalRow As Long With followUpSheet followUpFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Dim isMatch As Boolean Dim resultsRow As Long Dim masterRow As Long For resultsRow = 2 To resultsFinalRow For masterRow = 2 To masterFinalRow ... 

---

#3 Lay the framework for your loop

Dim isMatch As Boolean Dim resultsRow As Long Dim masterRow As Long For resultsRow = 2 To resultsFinalRow For masterRow = 2 To masterFinalRow isMatch = (resultsSheet.Cells(resultsRow, 2) = masterSheet.Cells(masterRow, 2)) _ And (resultsSheet.Cells(resultsRow, 1) = masterSheet.Cells(masterRow, 1)) If isMatch Then '/ Do Stuff End If Next masterRow Next resultsRow 

---

#4: Flesh out your loop logic

Rather than remembering which rows to delete at the end, just delete them as you go. Keeps things nice and clean.

Dim copyRange As Range Dim isMatch As Boolean Dim matchFound As Boolean Dim resultsRow As Long Dim masterRow As Long For resultsRow = 2 To resultsFinalRow matchFound = False For masterRow = 2 To masterFinalRow isMatch = (resultsSheet.Cells(resultsRow, 2) = masterSheet.Cells(masterRow, 2)) _ And (resultsSheet.Cells(resultsRow, 1) = masterSheet.Cells(masterRow, 1)) If isMatch Then matchFound = True With masterSheet Set copyRange = .Range(.Cells(masterRow, 1), .Cells(masterRow, 15)) End With copyRange.Copy Destination:=followUpSheet.Cells(followUpRow, 1) followUpRow = followUpRow + 1 End If Next masterRow If matchFound Then resultsSheet.Rows(resultsRow).Delete resultsRow = resultsRow - 1 End If Next resultsRow 

---

#5: Clean Up

With resultsSheet resultsFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row '/ find new final row Set copyRange = .Range(.Cells(1, 1), .Cells(resultsFinalRow, 15)) copyRange.Copy Destination:=masterSheet.Cells(masterFinalRow + 1, 1) End With 

---

Now we have a sub that's actually pretty clear and understandable:

Option Explicit Public Sub CRquestion() Dim targetBook As Workbook Set targetBook = "" '/ whatever xlwb is With targetBook Dim resultsSheet As Worksheet Set resultsSheet = targetBook.Sheets("results") Dim masterSheet As Worksheet Set masterSheet = targetBook.Sheets("Master List") Dim followUpSheet As Worksheet Set followUpSheet = targetBook.Sheets("Follow Ups") End With Dim resultsFinalRow As Long With resultsSheet resultsFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Dim masterFinalRow As Long With masterSheet masterFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Dim followUpFinalRow As Long With followUpSheet followUpFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Dim followUpRow As Long followUpRow = followUpFinalRow + 1 '/ next empty follow up row Dim copyRange As Range Dim isMatch As Boolean Dim matchFound As Boolean Dim resultsRow As Long Dim masterRow As Long For resultsRow = 2 To resultsFinalRow matchFound = False For masterRow = 2 To masterFinalRow isMatch = (resultsSheet.Cells(resultsRow, 2) = masterSheet.Cells(masterRow, 2)) _ And (resultsSheet.Cells(resultsRow, 1) = masterSheet.Cells(masterRow, 1)) If isMatch Then matchFound = True With masterSheet Set copyRange = .Range(.Cells(masterRow, 1), .Cells(masterRow, 15)) End With copyRange.Copy Destination:=followUpSheet.Cells(followUpRow, 1) followUpRow = followUpRow + 1 End If Next masterRow If matchFound Then resultsSheet.Rows(resultsRow).Delete resultsRow = resultsRow - 1 End If Next resultsRow With resultsSheet resultsFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row Set copyRange = .Range(.Cells(1, 1), .Cells(resultsFinalRow, 15)) copyRange.Copy Destination:=masterSheet.Cells(masterFinalRow + 1, 1) End With End Sub 

---

Performance Improvements

---

Standard VBA Tune Ups

The lowest-hanging VBA performance fruit are ScreenUpdating, EnableEvents and Calculation.

Application.ScreenUpdating = False Application.EnableEvents= False Application.Calculation= XlManual ... Code ... Application.ScreenUpdating = True Application.EnableEvents= True Application.Calculation= XlAutomatic 

Every time you access the worksheet, events trigger, formulas recalculate and Turning those options off will make your code inordinately faster. Just make sure they get reset back to normal at the end.

---

Delete all in one go

To iteratively build a list of rows to delete, then delete them all at once, the best way is to use Range.Union(). So you create a range then, whenever you find a row to delete, add that row to your range. At the end, take your compound range and call Range.EntireRow.Delete once to do the whole thing in one operation.

This would modify the code like so:

 Next masterRow If matchFound Then If deleteRange Is Nothing Then '/ for the first time we set the range Set deleteRange = resultsSheet.Cells(resultsRow, 1) Else '/ add the current row to our range Set deleteRange = Union(deleteRange, resultsSheet.Cells(resultsRow, 1)) End If End If Next resultsRow If Not deleteRange Is Nothing Then deleteRange.EntireRow.Delete