Excel VBA to cross match 2 sheets data and output into sheet3

satish78

Board Regular
Joined
Aug 31, 2014
Messages
218
Hi Friends,

Trying to match 2 sheets data and copy entire rows into sheet3
I been through posts on this mrexcel forum and on google search but did not find a correct vba to do the task.

In sheet1 ColumnB is always blank
In sheet2 ColumnE is always blank

I manually copied what results should look in sheet3 for clear understanding what I am trying to cross check data.

Sample file attached

https://spaces.hightail.com/space/sttiYg9isR

Satish
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
According to your example, should the columns Sheet1-colD be compared against Sheet2-colB?
 
Upvote 0
Try this

Code:
Sub cross_match_2_sheets()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim f As Range, lr As Long, i As Long
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set sh3 = Sheets("Sheet3")
  For i = 1 To sh1.Range("D" & Rows.Count).End(xlUp).Row
    Set f = sh2.Range("B:B").Find(sh1.Cells(i, "D").Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      lr = sh3.Range("E" & Rows.Count).End(xlUp).Row + 1
      sh3.Range("A" & lr).Value = sh2.Range("C" & i).Value
      sh3.Range("B" & lr).Value = sh2.Range("D" & i).Value
      sh3.Range("C" & lr).Value = sh1.Range("C" & i).Value
      sh3.Range("D" & lr).Value = sh2.Range("F" & i).Value
      sh3.Range("E" & lr).Value = sh1.Range("D" & i).Value
    End If
  Next
  MsgBox "End"
End Sub
 
Upvote 0
Try this

Code:
Sub cross_match_2_sheets()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim f As Range, lr As Long, i As Long
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set sh3 = Sheets("Sheet3")
  For i = 1 To sh1.Range("D" & Rows.Count).End(xlUp).Row
    Set f = sh2.Range("B:B").Find(sh1.Cells(i, "D").Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      lr = sh3.Range("E" & Rows.Count).End(xlUp).Row + 1
      sh3.Range("A" & lr).Value = sh2.Range("C" & i).Value
      sh3.Range("B" & lr).Value = sh2.Range("D" & i).Value
      sh3.Range("C" & lr).Value = sh1.Range("C" & i).Value
      sh3.Range("D" & lr).Value = sh2.Range("F" & i).Value
      sh3.Range("E" & lr).Value = sh1.Range("D" & i).Value
    End If
  Next
  MsgBox "End"
End Sub


Here is the code which I modified according the data present in different sheets and I changed sheets name.
Please correct me. I am getting run time error at Set f = sh2.Range("B:B").Find(sh1.Cells(i, "D").Value, , xlValues, xlWhole)


Sub cross_match_2_sheets()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim f As Range, lr As Long, i As Long
Set sh1 = Sheets("Sheet5")
Set sh2 = Sheets("Sheet6")
Set sh3 = Sheets("Sheet8")
For i = 1 To sh1.Range("D" & Rows.Count).End(xlUp).Row
Set f = sh2.Range("B:B").Find(sh1.Cells(i, "D").Value, , xlValues, xlWhole)
If Not f Is Nothing Then
lr = sh3.Range("E" & Rows.Count).End(xlUp).Row + 1
sh3.Range("A" & lr).Value = sh2.Range("C" & i).Value
sh3.Range("B" & lr).Value = sh2.Range("D" & i).Value
sh3.Range("C" & lr).Value = sh1.Range("C" & i).Value
sh3.Range("D" & lr).Value = sh2.Range("F" & i).Value
sh3.Range("E" & lr).Value = sh1.Range("D" & i).Value
End If
Next
MsgBox "End"
End Sub
 
Last edited:
Upvote 0
What do you have on sheet "Sheet5" in cell D1?
Do you have a formula?
Do you have an error in the cell?

Is the cell combined?


The problem is data, the macro works.


You can try macro with the data you put in your sample file.
 
Upvote 0
I copied that data into sample file.
It seems that some character is stopping to extract.
there are some weird characters like this

°ღ•ßŐŶÁ℘ÁŤℐ●•٠·˙


Is this stopping the script to run and complete.
And its not looping through all rows in sheet(s).

What do you have on sheet "Sheet5" in cell D1?
Do you have a formula?
Do you have an error in the cell?

Is the cell combined?


The problem is data, the macro works.


You can try macro with the data you put in your sample file.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,904
Messages
6,122,169
Members
449,070
Latest member
webster33

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
Back
Top