TropicalMagic
New Member
 Joined
 Jun 19, 2021
 Messages
 29
 Office Version

 365
 Platform

 Windows
Hi all,
I would like to compare cell values in column E of Workbook A’s worksheet 1 to those in column A of ReferenceList workbook’s worksheet 1.
Matching cell values will have their entire row be copied over to Workbook B’s worksheet 1, which will be empty at first.
I have placed the ranges into an array for speedier processing, since the number of rows can be in the 1000s.
The screenshots show mockup samples:
Workbook A’s worksheet 1:
ReferenceList’s worksheet 1:
However, the code is not working:
Can anyone help me with it?
Many thanks!
I would like to compare cell values in column E of Workbook A’s worksheet 1 to those in column A of ReferenceList workbook’s worksheet 1.
Matching cell values will have their entire row be copied over to Workbook B’s worksheet 1, which will be empty at first.
I have placed the ranges into an array for speedier processing, since the number of rows can be in the 1000s.
The screenshots show mockup samples:
Workbook A’s worksheet 1:
ReferenceList’s worksheet 1:
However, the code is not working:
VBA Code:
Sub ACCEPTED_OCEAN_OTQ_CHECK()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open ("WorkbookA.xlsx")
Workbooks.Open ("WorkbookB.xlsx")
Workbooks.Open ("ReferenceList")
Dim WorkbookA As Workbook
Set WorkbookA = Workbooks("WorkbookA.xlsx")
Dim WorkbookA_LASTROW, WorkbookA_LASTCOL As Long
WorkbookA_LASTROW = WorkbookA.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
WorkbookA_LASTCOL = WorkbookA.Sheets(1).Range("A1").CurrentRegion.Columns.Count
Dim WorkbookB As Workbook
Set WorkbookB = Workbooks("WorkbookB.xlsx")
Dim WorkbookB_LASTROW, WorkbookB_LASTCOL As Long
WorkbookB_LASTROW = WorkbookB.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
WorkbookB_LASTCOL = WorkbookB.Sheets(1).Range("A1").CurrentRegion.Columns.Count
Dim ReferenceList As Workbook
Set ReferenceList = Workbooks("ReferenceList.xlsx")
Dim ReferenceList_LASTROW, ReferenceList_LASTCOL As Long
ReferenceList_LASTROW = ReferenceList.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
ReferenceList_LASTCOL = ReferenceList.Sheets(1).Range("A1").CurrentRegion.Columns.Count
Dim i, j As Long
Dim Array1, Array2, Array3 As Variant
'Parse all values to an array, reducing interactions with the application
Array1 = Range(WorkbookA.Sheets(1).Cells(1), WorkbookA.Sheets(1).Cells(WorkbookA_LASTROW, WorkbookA_LASTCOL))
Array2 = Range(ReferenceList.Sheets(1).Cells(1), ReferenceList.Sheets(1).Cells(ReferenceList_LASTROW, ReferenceList_LASTCOL))
Array3 = Range(WorkbookB.Sheets(1).Cells(1), WorkbookB.Sheets(1).Cells(WorkbookB_LASTROW, WorkbookB_LASTCOL))
'Creates a temporary array for Workbook B
ReDim Array3(1 To WorkbookA_LASTROW, 1 To WorkbookA_LASTCOL)
'Check for matches in both Workbook A and Reference List, then copies entire row containing matches to Workbook B
For i = 1 To WorkbookA_LASTROW
If Array1(i, 5) = Array2(i, 1) Then
For j = 1 To WorkbookA_LASTCOL
Array3(i, j) = Array1(i, j)
Next
End If
Next
WorkbookB.Sheets(1).Range(WorkbookB.Sheets(1).Cells(1), WorkbookB.Sheets(1).Cells(WorkbookA_LASTROW, WorkbookB_LASTROW)) = Array3
Workbooks("WorkbookA.xlsx").Close SaveChanges:=True
Workbooks("WorkbookB.xlsx").Close SaveChanges:=True
Workbooks("ReferenceList").Close SaveChanges:=True
MsgBox "GENERATED!"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Can anyone help me with it?
Many thanks!