VBA Find Exact Matches in Two Workbooks and Copy Rows to New Sheet

[TheCobbler]

Hi there,

I'm looking to find exact matches in Column B in two workbooks.
If there is a match in Workbook2 (Sheet1) I want the entire Row of the matched values in Workbook2 (Sheet1) to be copied to a new worksheet in Workbook1.
If the same match happens more than once I always want it to be copied.

Thanks in advance for any assistance! I have previously looked at scripting dictionaries to complete this task but haven't been able to figure it out completely.
Cobb

Example Book 1:

Example Book 2:

Result:

 

[TheCobbler]

Got this so far... I thought I'd look at highlighting the rows with the ranges in the same workbook for now and then look at moving them later.
Not sure why this isn't working as it seems to find one match and then stop. Any thoughts? Thanks

Sub MtchRc()

    Dim MyRng1 As Range
    Dim MyRng2 As Range
    Dim iRow As Integer
    
    Set MyRng1 = Worksheets("Sheet1").Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    Set MyRng2 = Worksheets("Sheet2").Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    For Each MyRng1cell In MyRng1
        For Each MyRng2cell In MyRng2
        
            If MyRng1cell = MyRng2cell Then
            MyRng1cell.EntireRow.Interior.Color = vbCyan
            
            End If
        Next MyRng2cell
    Next MyRng1cell

End Sub

 

[alansidman]

Here is an alternative means to do what you wish using Power Query which is called Get and Transform Data and found on the Data Tab of your 365 version

let
    Source = Table.NestedJoin(Table1, {"Code"}, Table2, {"Code"}, "Table2", JoinKind.LeftOuter),
    #"Expanded Table2" = Table.ExpandTableColumn(Source, "Table2", {"Name", "Code", "Number", "Amount"}, {"Table2.Name", "Table2.Code", "Table2.Number", "Table2.Amount"}),
    #"Removed Other Columns" = Table.SelectColumns(#"Expanded Table2",{"Table2.Name", "Table2.Code", "Table2.Number", "Table2.Amount"}),
    #"Filtered Rows" = Table.SelectRows(#"Removed Other Columns", each ([Table2.Name] <> null))
in
    #"Filtered Rows"

Book2
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Name	Code	Number	Amount		Name	Code	Number	Amount		Table2.Name	Table2.Code	Table2.Number	Table2.Amount
2	Bob	_ABOB	30	2		Cookie	_BCOOK	40	5		Cookie	_BCOOK	40	5
3	Cookie	_BCOOK	40	5		Bear	_BEAR	50	6		Bear	_BEAR	50	6
4	Bear	_BEAR	50	6		Duke	_DDK	70	1		Bear	_BEAR	50	6
5	Coco	_COLA	60	9		Alfie	_ALF	80	4		Duke	_DDK	70	1
6	Duke	_DDK	70	1		Dolly	_DOL	90	9
7	Bear	_BEAR	50	6
8
Sheet1

 

[TheCobbler]

Thanks Alan. I'll look into this.

I'd ideally like something I can eventually use within a larger vba macro. Is this something I could call on from inside a macro? (apologies for my lack of knowledge!)

 

[alansidman]

You can, but this is not an area that I have worked in. Hopefully, someone else with a broader exposure your type of request can help. I did a little bit of google search and found the following that may help you.

How to automate a power query in VBA?

I have data in sheet 1. Normally I go to power query and do my transformations, then close, and load to an existing sheet 2. I would like to automate this using VBA, where I can just run my power q...

stackoverflow.com

 

[TheCobbler]

You can, but this is not an area that I have worked in. Hopefully, someone else with a broader exposure your type of request can help. I did a little bit of google search and found the following that may help you.

How to automate a power query in VBA?

I have data in sheet 1. Normally I go to power query and do my transformations, then close, and load to an existing sheet 2. I would like to automate this using VBA, where I can just run my power q...

stackoverflow.com

Great thanks! I think Power Query could help me with some other tasks too, so thanks for the suggestions.

 

[tonyyy]

A vba approach...

Sub MatchValues()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet
Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
Dim i As Long, j As Long, k As Long, n As Long

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("workbookname.xlsx")    '<----change to your workbook name
arr1 = wb1.Sheets(1).Range("A1").CurrentRegion
arr2 = wb2.Sheets(1).Range("A1").CurrentRegion

k = UBound(arr1) * UBound(arr2)
ReDim arr3(1 To k, 1 To 4)
arr3(1, 1) = "name"
arr3(1, 2) = "code"
arr3(1, 3) = "number"
arr3(1, 4) = "amount"

n = 2
For i = 2 To UBound(arr1)
    For j = 2 To UBound(arr2)
        If arr1(i, 2) = arr2(j, 2) Then
            arr3(n, 1) = arr2(j, 1)
            arr3(n, 2) = arr2(j, 2)
            arr3(n, 3) = arr2(j, 3)
            arr3(n, 4) = arr2(j, 4)
            n = n + 1
        End If
    Next j
Next i
Set ws1 = wb1.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
ws1.Range(ws1.Cells(1, 1), ws1.Cells(k, 4)).Value = arr3
End Sub

Cheers,

Tony

 

[TheCobbler]

Apologies for the delay in response. Wow Tony! That is spot on and far faster the code I managed to scrape together.

So simply put this code sets the upper array for the used range on both books.
Then it uses incrementing counters to check if each used cell of arr1 is in arr2. If is a match the data is captured in arr3.
Eventually it adds a sheet to the active workbook and fills with the data saved to arr3?

Thank you so much for this!
Cobb

 

[tonyyy]

Cobb,
The lower boundary and upper boundary for arrays arr1 and arr2 are determined by the .CurrentRegion property (as opposed to .UsedRange). The upper boundary for array arr3 is calculated by multiplying UBound(arr1) * UBound(arr2)... as this will accommodate the potential maximum number of matches.
And as you've experienced, using arrays is much faster than cells/ranges.
Glad it all worked for you. You're very welcome.
Tony