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
Sub ...and... End Sub\$\endgroup\$