vba - Run through a loop for more than 100,000 rows of data in two sheets in the same workbook

Question

I currently have code to allow me to look through the rows with matching ID from Sheet 1 and Sheet 2. When both IDs match, Sheet 2 information will be pasted to the Sheet 1 rows with the same IDs. My code works on less than 1,000 rows and when I tested it gave results within a minute.

The problem is that when I tried to run it for 1,000,000 rows it keeps running and for more than 20 minutes and never stop running since then. I hope anyone could assist me in making changes to the code to allow me to do a loop and copy paste the information from Sheet 2 to Sheet 1 for 200,000 rows.

Sub Sample()


  Dim tracker As Worksheet
    Dim master As Worksheet
    Dim cell As Range
    Dim cellFound As Range
    Dim OutPut As Long

   Set tracker = Workbooks("test.xlsm").Sheets("Sheet1")
   Set master = Workbooks("test.xlsm").Sheets("Sheet2")

   Application.ScreenUpdating = False
    For Each cell In master.Range("A2:A200000")

        Set cellFound = tracker.Range("A5:A43000").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not cellFound Is Nothing Then
      matching value

            cellFound.Offset(ColumnOffset:=1).Value2 = cell.Offset(ColumnOffset:=2).Value2


        Else

        End If
        Set cellFound = Nothing
        Debug.Print cell.Address
    Next
    Application.ScreenUpdating = True
    OutPut = MsgBox("Update over!", vbOKOnly, "Update Status")


End Sub

Above is the code that I have for now.

Answer 1

Incorporating @paulbica's suggestion, this ran in several seconds for me.

Sub Sample()

    Dim rngTracker As Range
    Dim rngMaster As Range
    Dim arrT, arrM
    Dim dict As Object, r As Long, tmp

    With Workbooks("test.xlsm")
        Set rngTracker = .Sheets("Tracker").Range("A2:B43000")
        Set rngMaster = .Sheets("Master").Range("A2:C200000")
    End With

    'get values in arrays
    arrT = rngTracker.Value
    arrM = rngMaster.Value

    'load the dictionary
    Set dict = CreateObject("scripting.dictionary")
    For r = 1 To UBound(arrT, 1)
        dict(arrT(r, 1)) = r
    Next r

    'map between the two arrays using the dictionary
    For r = 1 To UBound(arrM, 1)
        tmp = arrM(r, 1)
        If dict.exists(tmp) Then
            arrT(dict(tmp), 2) = arrM(r, 3)
        End If
    Next r

    rngTracker.Value = arrT

End Sub