Before getting to speed improvements, there are some structural and language best practices to address.
Best Practice: Always declare Option Explicit
at the top of the module to ensure all variable used in your code are declared more info here . Make it automatic: in the VBIDE, check the 'Tools -> Options... -> (Editor tab) Require Variable Declaration' option.
Best Practice: If Application
flags must be set and reset, use error handling to guarantee that it happens. The current code is structured as:
Sub moduleUpdate()
'{declarations}
'{set workbook/worksheet variables}
Application.ScreenUpdating = False
'{executable code...} <= if an error/exception occurs in any of this code, the 'Clean up' code is not executed
'Clean up
Application.CutCopyMode = False
Application.ScreenUpdating = True
'DstFile.Save
'DstFile.Close
End Sub
Instead, use the On Error Goto XXX
statement to guarantee that the 'Clean up' code is executed
Option Explicit
Sub moduleUpdate()
'{declarations}
'{set workbook/worksheet references}
Application.ScreenUpdating = False
On Error Goto Cleanup '<= guarantees that the 'Clean up' code executes
'{executable code...} <= if an error/exception occurs in any of this code, execution jumps to the 'Cleanup:' label
Cleanup:
Application.CutCopyMode = False
Application.ScreenUpdating = True
'DstFile.Save
'DstFile.Close
End Sub
Best Practice: Avoid use of ActiveWorkbook
and ActiveSheet
. Instead, create dedicated variables that hold references to these documents. Using ActiveWorkbook
and ActiveSheet
may result in unexpected workbook and sheet references. This is an excellent resource regarding not using Select
, ActiveSheet
, etc.
The code sets up dedicated variables here:
Dim DstFile As Workbook
Set DstFile = Workbooks("ExtractFile.xlsx")
Dim wsSource As Worksheet
Set wsSource = Workbooks("ExtractFile.xlsx").Worksheets("Sheet1")
Dim wsDest as Worksheet
Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")
As a new reader of the code, DstFile
and wsDest
names are confusing since 'Dst' and 'Dest" both look like abbreviation of the word 'destination'. To avoid this situation the code below changes the variable names as follows:
Dim extractWorkbook As Workbook
Set extractWorkbook = Workbooks("ExtractFile.xlsx")
Dim extractWorksheet As Worksheet
Set extractWorksheet = extractWorkbook.Worksheets("Sheet1")
Dim wsDest as Worksheet
Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")
The expression:
LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
is executed 3 times within the code, but the result LastRow
is only used once.
The first time this expression is executed, it is unclear what is the 'ActiveSheet'.
It took some experimenting with fake data files, but it seems that for this code to work, the moduleUpdate
must be invoked while "ExtractFile.xlsx" is the active worksheet. Rather than counting on this condition to pre-exist, simply drop the use of ActiveSheet
and use variable extractWorksheet
.
The second time it is invoked, it is more apparent that ActiveSheet
refers to extractWorksheet
. Again, it doesn't really matter since this assignment to LastRow
is not used - but it is better to explicitly use variable extractWorksheet
.
The third time the expression is invoked, wsDest is activated so it is now the 'ActiveSheet':
Selection.Copy '<= copies the selection of the ActiveSheet (extractWorksheet) to the clipboard
Workbooks("Workbook.xlsx").Activate '<= the workbook containing wsDest becomes the 'ActiveWorkbook'
ActiveWorkbook.Sheets("Sheet1").Activate ' <= wsDest is the ActiveSheet
LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 'last row of the `ActiveSheet (wsDest)
Range("A" & LastRows).Select '<= this is a Range within the 'ActiveSheet (wsDest)
'Now, rather than use 'ActiveSheet' OR wsDest, the paste target is explicitly identified !?
Workbooks("Workbook.xlsx").Worksheets("Sheet1").PasteSpecial
So, certainly the first 2 expression can be deleted. It may not speed up execution, but removing all the implicit references to the ActiveSheet
is an improvement to the 3rd use of LastRows
.
Using faked data and the original code, the logic seems to copy rows from extractWorksheet
to wsDest
where a matching value is not found. This behavior does not quite agree with your description, but it makes sense if the goal is to copy 'new' rows from extractWorksheet
to wsDest
worksheet. So, the remainder of this answer assumes this observation is correct.
One last Best Practice: Within Subroutines and Functions, declare local variables close to their initial use. Makes code easier to read/interpret.
Now...speed
There are two loops in the current code. Each loop iterates presumably thousands of times. So, to speed up execution, the code below employs the suggested best practices and does the following to improve execution speed.
- Declare/Initialize objects and reference values from objects once (outside of the loop) as much as possible. These kinds of operations can be an expensive when done thousands of times.
- Iterate through the datasets using a single loop instead of two. Evaluate for a match and copy the data if required within the same iteration.
- Avoid copy/paste operations using the clipboard
Option Explicit
Sub moduleUpdate()
Dim extractWorkbook As Workbook
Set extractWorkbook = Workbooks("ExtractFile.xlsx")
Dim extractWorksheet As Worksheet
Set extractWorksheet = extractWorkbook.Worksheets("Sheet1")
Dim wsDest As Worksheet
Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")
On Error GoTo Cleanup
Application.ScreenUpdating = False
Dim recRow As Long
recRow = 1
With extractWorksheet
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Create the Range object to search with 'Find once...declare and initialize it outside of the loop
Dim wsDestRange As Range
Set wsDestRange = wsDest.Range("A:A")
'Determine where to begin appending rows of data to wsDest worksheet
Dim wsDestNextRowNumber As Long
wsDestNextRowNumber = wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 1
Dim fCell As Range 'this needs a better name, 'fCell" is not descriptive
Dim extractWorksheetCell As Range
Dim rowNum As Long
For rowNum = 2 To lastRow
Set extractWorksheetCell = .Cells(rowNum, "A")
Set fCell = wsDestRange.Find(what:=extractWorksheetCell.Value, LookAt:=xlWhole, MatchCase:=False)
If fCell Is Nothing Then 'Value does not exist in the wsDest worksheet
'Is setting the color really required, or was the color attribute used used as a marker?
extractWorksheetCell.Interior.Color = vbBlue
'Append the entire row's content to the wsDest worksheet
extractWorksheetCell.EntireRow.Copy wsDest.Range("A" & CStr(wsDestNextRowNumber))
wsDestNextRowNumber = wsDestNextRowNumber + 1
End If
Next rowNum
End With
Cleanup:
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
If the above changes do not speed up execution sufficiently, then you may need to investigate manipulations using arrays, collections and dictionaries. Good luck!