Comparing Data from 2 Sheets and Copy using VBA

[madhuchelliah]

Hello all, I have data in sheet1 and sheet2. Sheet1 is source data and sheet2 is input. I want to compare data in column A and B of both sheets. i.e comparing as combinations. In the example below, the VBA has to look for combinations, if it matches in both sheets then data in sheet2 B column has to be copied to sheet1 C column. If no matching combination available then it should be leave blank. Please refer the example for more clarity. THank you

Input Sheet1

Book6
	A	B
1	Reg. Number	Note
2	2019JECAE222	English Book
3	2019JECAE222	Maths Book
4	2019JECAE222	Physics Book
5	2019JECAE222	Chemistry Book
6	2019JECAE223	English Book
7	2019JECAE223	Maths Book
8	2019JECAE223	Chemistry Book
9	2019JECAE224	Maths Book
10	2019JECAE224	Physics Book
11	2019JECAE224	Chemistry Book
Sheet1

Input Sheet2

Book6
	A	B
1	Reg. Number	Note
2	2019JECAE222	English Book
3	2019JECAE222	Chemistry Book
4	2019JECAE223	English Book
5	2019JECAE223	Chemistry Book
6	2019JECAE224	Maths Book
7	2019JECAE224	Chemistry Book
Sheet2

Output in Sheet1

Book6
	A	B	C
1	Reg. Number	Note	from sheet2 column B
2	2019JECAE222	English Book	English Book
3	2019JECAE222	Maths Book
4	2019JECAE222	Physics Book
5	2019JECAE222	Chemistry Book	Chemistry Book
6	2019JECAE223	English Book	English Book
7	2019JECAE223	Maths Book
8	2019JECAE223	Chemistry Book	Chemistry Book
9	2019JECAE224	Maths Book	Maths Book
10	2019JECAE224	Physics Book
11	2019JECAE224	Chemistry Book	Chemistry Book
Sheet1

 

[JEC]

In C2 of sheet1: (close that one with ctrl+shift+return and fill down, its a matrix formula)

=IFERROR(INDEX(Sheet2!$B$2:$B$7,MATCH(A2&B2,Sheet2!$A$2:$A$7&Sheet2!$B$2:$B$7,0)),"")

 

[madhuchelliah]

In C2 of sheet1: (close that one with ctrl+shift+return and fill down, its a matrix formula)

=IFERROR(INDEX(Sheet2!$B$2:$B$7,MATCH(A2&B2,Sheet2!$A$2:$A$7&Sheet2!$B$2:$B$7,0)),"")

Hey JEC, it is working as expected but my requirement is with VBA solution. Thanks for your time.

 

[Akuini]

Hi, @madhuchelliah
Try this:

Sub a1180373a()
Dim i As Long
Dim tx As String
Dim va, vb, vc
Dim d As Object

With Sheets("Sheet2")
    va = .Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

For i = 1 To UBound(va, 1)
    d(va(i, 1) & "|" & va(i, 2)) = va(i, 2)
Next


With Sheets("Sheet1")
    vb = .Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row)

    ReDim vc(1 To UBound(vb, 1), 1 To 1)
    
    For i = 1 To UBound(vb, 1)
        tx = vb(i, 1) & "|" & vb(i, 2)
        If d.Exists(tx) Then vc(i, 1) = d(tx)
    Next
    
    .Range("C2").Resize(UBound(vc, 1), 1) = vc

End With
End Sub

 

[madhuchelliah]

Hi, @madhuchelliah
Try this:

Sub a1180373a()
Dim i As Long
Dim tx As String
Dim va, vb, vc
Dim d As Object

With Sheets("Sheet2")
    va = .Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

For i = 1 To UBound(va, 1)
    d(va(i, 1) & "|" & va(i, 2)) = va(i, 2)
Next


With Sheets("Sheet1")
    vb = .Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row)

    ReDim vc(1 To UBound(vb, 1), 1 To 1)
   
    For i = 1 To UBound(vb, 1)
        tx = vb(i, 1) & "|" & vb(i, 2)
        If d.Exists(tx) Then vc(i, 1) = d(tx)
    Next
   
    .Range("C2").Resize(UBound(vc, 1), 1) = vc

End With
End Sub

Hey Akuini, it is working as expected. Thanks for your time.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.

 

[JEC]

One more

Sub jvr()
  ar = Sheets(1).Cells(1).CurrentRegion.Resize(, 3)
  ar2 = Sheets(2).Cells(1).CurrentRegion.Resize(, 3)
  
  For i = 2 To UBound(ar2)
    ar2(i, 3) = ar2(i, 1) & ar2(i, 2)
  Next
  
  For i = 2 To UBound(ar)
    x = Application.Match(ar(i, 1) & ar(i, 2), Application.Index(ar2, 0, 3), 0)
    If IsNumeric(x) Then ar(i, 3) = Application.Index(ar2, x, 2)
  Next
    
  Sheets(1).Cells(1).CurrentRegion.Resize(, 3) = ar
End Sub