Excel VBA - Compare matching cell values in arrays and copy entire rows

TropicalMagic

New Member
Joined
Jun 19, 2021
Messages
29
Office Version
  1. 365
Platform
  1. 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 mock-up samples:


Workbook A’s worksheet 1:

1.png



ReferenceList’s worksheet 1:
2.png



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!
 

TropicalMagic

New Member
Joined
Jun 19, 2021
Messages
29
Office Version
  1. 365
Platform
  1. Windows
It
That would suggest that the output array is empty, when the error occurs hover the mouse over the nr variable, what does it show?
It shows that nr = 0

Does it mean that it's not loading into Workbook B?
 

Attachments

  • S1.png
    S1.png
    5.9 KB · Views: 3

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
68,276
Office Version
  1. 365
Platform
  1. Windows
It means there were no matches found between the reference list & col E of bookA
 

TropicalMagic

New Member
Joined
Jun 19, 2021
Messages
29
Office Version
  1. 365
Platform
  1. Windows
It means there were no matches found between the reference list & col E of bookA

I rechecked the referencing of my columns and found that I had accidentally deleted a column before E so it shifted away.

Once I changed it, it worked perfectly!

Here is the working code, comparing Column E in Workbook A's Worksheet 1 to Column A in Workbook C's Worksheet 1, thereafter copying the entire row for matching values to Workbook B's Worksheet 1:

VBA Code:
Sub MY_SUB()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim WbkA As Workbook, WbkB As Workbook, WbkC As Workbook
Dim Ary As Variant, Nary As Variant
Dim Dic As Object
Dim r As Long, c As Long, nr As Long

Set WbkA = Workbooks.Open(Application.DefaultFilePath & "\" & "WorkbookA.xlsx")
Set WbkB = Workbooks.Open(Application.DefaultFilePath & "\" & "WorkbookB.xlsx")
Set WbkC = Workbooks.Open(Application.DefaultFilePath & "\" & "ReferenceList.xlsx")

Set Dic = CreateObject("scripting.dictionary")
Dic.comparemode = 1

With WbkC.Sheets(1)
    Ary = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value2
End With

For r = 1 To UBound(Ary)
    Dic(Ary(r, 1)) = Empty
Next r

With WbkA.Sheets(1)
    c = .Cells(1, Columns.Count).End(xlToLeft).Column
    Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, c).Value2
End With

ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
For r = 1 To UBound(Ary)
    If Dic.Exists(Ary(r, 5)) Then
        nr = nr + 1
        For c = 1 To UBound(Ary, 2)
        Nary(nr, c) = Ary(r, c)
        Next c
    End If
Next r

WbkB.Sheets(1).Range("A1").Resize(nr, UBound(Nary, 2)).Value = Nary

WbkA.Close True
WbkB.Close True
WbkC.Close True

MsgBox "GENERATED!"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 

TropicalMagic

New Member
Joined
Jun 19, 2021
Messages
29
Office Version
  1. 365
Platform
  1. Windows
It means there were no matches found between the reference list & col E of bookA
I would like to extend my sincere thanks to you for helping me to generate a functioning solution and trouble-shooting the errors!

It performed exactly as I intended!

Much appreciated!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
68,276
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Glad to help & thanks for the feedback.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,770
Office Version
  1. 2010
Platform
  1. Windows
I considered it but however, I'll be running the report generation daily thus I am seeking a VBA-oriented solution to automate away repetitive effort and human errors.
So you misread / did not understand as I was stating for a quick VBA solution needing ten codelines just using some Excel basics !​
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
68,276
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

So you misread / did not understand as I was stating for a quick VBA solution needing ten codelines just using some Excel basics !
Then why didn't you just post the code, rather than some vague & ambiguous comment?
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,770
Office Version
  1. 2010
Platform
  1. Windows

Yes with some attachment and a positive answer from the OP and as this way can be found in every Excel forum as this is a well known solution …​
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
68,276
Office Version
  1. 365
Platform
  1. Windows
No attachments needed. Especially if it's a "Well known solution"
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,770
Office Version
  1. 2010
Platform
  1. Windows
As it depends on the OP skills to adapt a generic code to his need and​
as I do not like to waste my time the reason why I prefer to work on an attachment for accuracy …​
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,482
Messages
5,770,349
Members
425,612
Latest member
martinijr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top