Compare and find duplicates in 2 corresponding columns in 2 sheets

I want to compare (500) and find duplicate daily records within 2 sheets, and copy the unmatched row to another sheet, copy the match from another to 3rd sheet, and delete the matched records from original sheet.

I have 3 worksheets (results, Master List, Follow Ups) " results" update daily with 500 records, and added to "master list", duplicate row added to "follow ups"

All have similar columns heading A to O.

I want to compare Column B (unique) and column A of worksheet "results" to " Master List".

The flow would be:

• Match a first cell value in column B of "results" to Column B cell values of " Master List"

• If match found - compare column A of "results" to Column A cell values of " Master List"

-
If match found

• Copy the row of match from "Master List" for Column A to O to next available row of "Follow Ups"

• Mark the match row in "results" to be deleted in the end when search loop finished

-
Else if match not found

• check next value in column B of " result" until last record

-
When whole search ends, delete marked records for match found in "results" and copy all the left out records to Next available table row in "Master List".


I am kind of stuck and don't want to run in long loop, looking for expert help with shortest and fastest possible code. Here is some code already written and working, but not working well.

If possible optional approach (can both column value jointly compared with another sheet):

```
Set sht1 = xlwb.Worksheets("results")
Set sht4 = xlwb.Worksheets("Master List")
Set sht5 = xlwb.Worksheets("Follow Ups")

For i = 2 To sht1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
For j = 2 To sht4.Range("A1").SpecialCells(xlCellTypeLastCell).Row
If sht1.Cells(i, 2) = sht4.Cells(j, 2) And sht1.Cells(i, 1) = sht4.Cells(j, 1) Then

'sht4.Rows(j).Copy
' sht5.Activate

'sht5.Cells(

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

StackExchange Code Review Q#131708, answer score: 6