Macro to copy data from master sheet if match is found

Hi..
My problem is as below..
Match the values in Column B of worksheet 2 with column B of worksheet 1. If match is found, select the matched cell of worksheet 1, copy the value from column W from corresponding row and paste it in Y column of worksheet 2. Below is format of data:

Worksheet 1:
Column B Column W
50 Bulb
51 Lamp
52 Tubelight
53 Bulb
54 Lamp

Worksheet 2:
Column B Column Y
2
4
50 Bulb
60
70

I want to use index and match function. But I am not able to write formula for that.
Kindly help me in this regard.
Thanks for time spent in going through this post and for replying..

or try this :

=IFERROR(INDEX(Sheet1!$W:$W,MATCH(Sheet2!B2,Sheet1!$B:$B,0)),"")

Thanks for your reply..but I want to write this in macro..I am new to VBA..
I tried this

Sht1Rng = Sheets(1).Range("B65536").End(xlUp).Row
Sht2Rng = Sheets(2).Range("B65536").End(xlUp).Row
For i = Sht2Rng To 1 Step -1
Sheets(2).Cells(i, 25).Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX(Sheet1!$W:$W,MATCH(Sheet2!B2,Sheet1!$B:$B,0)),"")"
Next i

but the above code is not working..what modifications I have to do?

Thanks for your reply..but I want to write this in macro..I am new to VBA..
I tried this

Sht1Rng = Sheets(1).Range("B65536").End(xlUp).Row
Sht2Rng = Sheets(2).Range("B65536").End(xlUp).Row
For i = Sht2Rng To 1 Step -1
Sheets(2).Cells(i, 25).Select
ActiveCell.FormulaR1C1 = _
"=INDIRECT("Sheet1!R2C23" & MATCH(R2C2,Sheet1!R2C2:R50000C2,0))"
Next i

but the above code is not working..what modifications I have to do?

This code works as long as you do not mind with the speed if you have large data

Sub find_events1()

Dim c2 As Range, c As Range, LR As Long

    Application.ScreenUpdating = 0
    Application.EnableEvents = 0

With Sheets("Sheet2")
    LR = .UsedRange.Rows.Count
    For Each c In .Range("B2:B" & LR)
        If Trim(c.Value) <> vbNullString Then
            Set c2 = Sheets("Sheet1").Columns(2).Find(c.Value, , , xlWhole)
            If Not c2 Is Nothing Then
            .Cells(c.Row, "Y").Value = c2.Value
            End If
        End If
        
    Next
End With
    Application.ScreenUpdating = 1
    Application.EnableEvents = 1
End Sub

Thanks for your reply, AB33..
My data is very large hence I need a macro which has less execution time..
I have tested below code..its working but the issue is of speed..due to 2 for loops its taking time to execute. I want to eliminate 1 for loop. Any help in this regard will be much appreciated.

Sht1Rng = Sheets(1).Range("B65536").End(xlUp).Row
Sht2Rng = Sheets(2).Range("B65536").End(xlUp).Row

For i = Sht2Rng To 1 Step -1
For J = Sht1Rng To 1 Step -1
If Sheets(1).Cells(J, 2) = Sheets(2).Cells(i, 2) Then
Sheets(2).Cells(i, 25) = Sheets(1).Cells(J, 23)
End If
Next J
Next i

Thank you all for your timely help..
Below code with some modifications is working fine but somehow this code is also considering headers of the columns and matching the values. I want to start from row 2. I tried but could not modify. Can you please help me in this regard?

Originally Posted by AB33

This code works as long as you do not mind with the speed if you have large data

Sub find_events1()

Dim c2 As Range, c As Range, LR As Long

    Application.ScreenUpdating = 0
    Application.EnableEvents = 0

With Sheets("Sheet2")
    LR = .UsedRange.Rows.Count
    For Each c In .Range("B2:B" & LR)
        If Trim(c.Value) <> vbNullString Then
            Set c2 = Sheets("Sheet1").Columns(2).Find(c.Value, , , xlWhole)
            If Not c2 Is Nothing Then
            .Cells(c.Row, "Y").Value = c2.Value
            End If
        End If
        
    Next
End With
    Application.ScreenUpdating = 1
    Application.EnableEvents = 1
End Sub

I know my code is slow, but your code is much slower than mine

If you do not have duplicates, this code is much faster than range looping

Sub test()
    Dim a, i As Long
    a = Sheets("sheet2").Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            .Item(a(i, 1)) = Trim(a(i, 1))
        Next
        a = Sheets("sheet1").Range("B1:Y" & Cells(Rows.Count, 2).End(xlUp).Row)
        For i = 1 To UBound(a, 1)
            If Trim(.Exists(a(i, 1))) Then a(i, 1) = .Item(a(i, 1))
        Next
    End With
    Sheets("sheet2").Cells(Rows.Count, "Y").End(xlUp).Offset(1) = a
End Sub

Thanks again AB33..
I am new to vba..just want to know is it possible to use inbuilt functions such as index and match to above code? If yes, how should I modify the macro?

index and match,no as far as I know. Dictionary script can deal with unique values ONLY. With Index and Match there are ways of returning duplicate values. Why do you need to use a code? I and M can simpley do your task.

Hi..sorry for confusion..but I want to use index and match functions in vba code.

Oli,
The OP is looking for ideal solution! IMO, it does not exist. The Find function can cope with duplicates, but very slow with large data and dictionary can not cope with duplicates. I would prefer to use a simple Excel I and M function, with out the complication of codes.

From your posting on #4, i think this what you are looking for :

Sub test()
Dim i, Sht1Rng As Long
    Sht1Rng = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
    For i = Sht1Rng To 1 Step -1
        Sheets("sheet2").Cells(i, 25).Formula = "=IFERROR(INDEX(Sheet1!$W:$W,MATCH(Sheet2!B" & i & ",Sheet1!$B:$B,0))" & ","""")"
    Next i
End Sub

Below code is not extracting values from Column W of mastersheet..

Originally Posted by SDCh

From your posting on #4, i think this what you are looking for :

Sub test()
Dim i, Sht1Rng As Long
    Sht1Rng = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
    For i = Sht1Rng To 1 Step -1
        Sheets("sheet2").Cells(i, 25).Formula = "=IFERROR(INDEX(Sheet1!$W:$W,MATCH(Sheet2!B" & i & ",Sheet1!$B:$B,0))" & ","""")"
    Next i
End Sub

From your posting on #4, i think this what you are looking for :

Sub test()
Dim i, Sht1Rng As Long
    Sht1Rng = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
    For i = Sht1Rng To 1 Step -1
        Sheets("sheet2").Cells(i, 25).Formula = "=IFERROR(INDEX(Sheet1!$W:$W,MATCH(Sheet2!B" & i & ",Sheet1!$B:$B,0))" & ","""")"
    Next i
End Sub

Thanks a lot..made some changes..now its working like a charm..

Originally Posted by SDCh

From your posting on #4, i think this what you are looking for :

Sub test()
Dim i, Sht1Rng As Long
    Sht1Rng = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
    For i = Sht1Rng To 1 Step -1
        Sheets("sheet2").Cells(i, 25).Formula = "=IFERROR(INDEX(Sheet1!$W:$W,MATCH(Sheet2!B" & i & ",Sheet1!$B:$B,0))" & ","""")"
    Next i
End Sub

Glad to know your problem has been solved