excel vba to add data when matched - excel

Question

I am trying to run a match of values from sheet 10 which loops from 2 to 11000
looking for a match in in column A of sheet 10 with column A of sheet3. Then if matched copy value from column B sheet 3 to column F of sheet10 , my code below works , but it takes 25 mins to run. Is there a quicker way to run this please
Sub update_OpGroup()
Dim lastrow10, lastrow3
lastrow10 = Sheet10.Range("A" & Rows.Count).End(xlUp).Row
lastrow3 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
Dim x, y, b
b = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For x = 1 To lastrow10
For y = 2 To lastrow3
If Sheet10.Range("A" & x).Value = Sheet3.Range("A" & y).Value Then Sheet10.Range("F" & x).Value = Sheet3.Range("B" & y).Value: GoTo foundit
Next y
foundit:
Next x
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

you could use Find() method of Range object:
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim found As Range
For x = 1 To lastrow10
Set found = Sheet3.Range("A2:A" & lastrow3).Find(what:=Sheet10.Range("A" & x).Value, lookat:=xlValues, LookIn:=xlWhole)
If Not found Is Nothing Then Sheet10.Range("F" & x).Value = Sheet3.Range("B" & found.Row).Value
Next x
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

Answer 2

I believe an INDEX/MATCH formula may fulfill your needs much quicker than VBA copy/paste.
If the range in column A is always fixed, the below formula works:
=INDEX(Sheet3!$B:$B,MATCH(Sheet10!$A:$A,Sheet3!$A:$A,0),1)
If the range is varied, the below VBA should cover it:
Sub Fill_Formula()
Dim lRow As String
lRow = Worksheets("Sheet10").Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Worksheets("Sheet10").Range("F2").FormulaR1C1 = "=INDEX(Sheet3!C2,MATCH(Sheet10!C1,Sheet3!C1,0),1)"
Worksheets("Sheet10").Range("F2").AutoFill Destination:=Worksheets("Sheet10").Range("F2:F" & lRow), Type:=xlFillDefault
End Sub
If a formula isn't acceptable in the cells you could add:
Worksheets("Sheet10").Range("F2:F" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False