If, IsError, Then Loop Comparing 4 Columns of Cells - vba

Question

Straight to the point:
I am trying to match A2 on sheet "PRD" to A2 on sheet "CRD", if this is a match I want to compare B2 on sheet PRD to B2 on sheet CRD and then A3 same thing on and on to the end of the range. If there is no match between cells in column A I am trying to copy the whole row to a third sheet, if there is a match between cells in A but there is not a match between cells in B I am trying to copy the row to a third sheet.
I am stuck, I think after hours of looking at the code and Googling, not being able to check column B... I seem to be able to check, copy and paste cells that do not match contents in column A fine.
I hope I am asking the right questions and am clear, thanks for any help!!
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range
Dim cell As Range
Dim cell2 As Range
Dim lastrow As Long
'CRD date
With ThisWorkbook.Worksheets("CRD")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set r1 = .Range("A2:A" & lastrow)
End With
'CRD quantity
With ThisWorkbook.Worksheets("CRD")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set r3 = .Range("B2:B" & lastrow)
End With
'PRD date
With ThisWorkbook.Worksheets("PRD")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set r2 = .Range("A2:A" & lastrow)
End With
'PRD quantity
With ThisWorkbook.Worksheets("PRD")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set r4 = .Range("B2:B" & lastrow)
End With
'match PRD date to CRD date: output "Found" for record, or copy/paste onto report page
Range("A2").Select
For Each cell In r1
If IsError(Application.Match(cell, r2, 0)) Then
'select active cell's row and copy, pasting in report page
Rows(ActiveCell.Row).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CRD").Select
Application.CutCopyMode = False
'if no error check quantity(B) of same cell, if match continue, if no match copy
ElseIf IsError(Application.Match(r3, r4, 0)) Then
For Each cell2 In r3
Rows(ActiveCell.Row).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CRD").Select
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
Application.CutCopyMode = False
Next
Else
End If
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Next
End Sub

Answer 1

Your code relies too much on Select, ActiveCell, Selection and Activate, you should avoid all these Selecting and use fully qualified objects instead.
See the code below, and explanations inside the code's comments.
Modified Code
Option Explicit
Sub Match2Columns()
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range
Dim cell As Range
Dim cell2 As Range
Dim lastrow As Long
'CRD date
With ThisWorkbook.Worksheets("CRD")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set r1 = .Range("A2:A" & lastrow)
End With
'CRD quantity
With ThisWorkbook.Worksheets("CRD")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set r3 = .Range("B2:B" & lastrow)
End With
'PRD date
With ThisWorkbook.Worksheets("PRD")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set r2 = .Range("A2:A" & lastrow)
End With
'PRD quantity
With ThisWorkbook.Worksheets("PRD")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set r4 = .Range("B2:B" & lastrow)
End With
Dim PasteRow As Long ' row to paste at "sheet1"
'match PRD date to CRD date: output "Found" for record, or copy/paste onto report page
With ThisWorkbook.Worksheets("CRD") ' <-- make sure you are looping and copying from "CRD" sheet
For Each cell In r1
If IsError(Application.Match(cell, r2, 0)) Then
' select active cell's row and copy, pasting in report page
.Rows(cell.Row).Copy
' get last empty row and add 1 row where to paste
PasteRow = Sheets("Sheet1").Range("A1").End(xlDown).Row + 1
' paste action
Sheets("Sheet1").Range("A" & PasteRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'if no error check quantity(B) of same cell, if match continue, if no match copy
ElseIf IsError(Application.Match(r3, r4, 0)) Then
For Each cell2 In r3
' select active cell's row and copy, pasting in report page
.Rows(cell2.Row).Copy
' get last empty row and add 1 row where to paste
PasteRow = Sheets("Sheet1").Range("A1").End(xlDown).Row + 1
' paste action
Sheets("Sheet1").Range("A" & PasteRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next cell2
Else
' you are doing nothing here, not sure why you need it ???
End If
Next cell
End With
End Sub