An update query takes very long time (1 Viewer)

UPDATE tblFinal INNER JOIN tblList ON tblFinal.Type = tblList.Range SET tblFinal.Customer = tblList.Customer
WHERE (((tblFinal.CodeNumber) Between [tblList].[StartRange] And [tblList].[EndRange]));

Public Function fncUpdateTBLFinal()

    Const TARGET_TABLE As String = "tblFinal"
    Const SOURCE_TABLE As String = "tblList"
    
    Dim rsTarget    As DAO.Recordset
    Dim rsSource    As DAO.Recordset
    Dim qd          As DAO.QueryDef
    Dim db          As DAO.Database
    
    Set db = CurrentDb
    Set rsTarget = db.OpenRecordset(TARGET_TABLE, dbOpenDynaset)
    With rsTarget
        If Not (.BOF And .EOF) Then .MoveFirst
        While Not .EOF
            Set qd = db.CreateQueryDef(vbNullString, _
                        "SELECT Customer FROM " & SOURCE_TABLE & " " & _
                        "WHERE (Range = p1) And (p2 " & _
                        "BETWEEN [StartRange] AND [EndRange]);")
            qd.Parameters(0).Value = !Type.Value
            qd.Parameters(1).Value = !CodeNumber.Value
            Set rsSource = qd.OpenRecordset(dbOpenSnapshot)
            If Not (rsSource.BOF And rsSource.EOF) Then
                rsSource.MoveFirst
                .Edit
                !Customer = rsSource(0)
                .Update
            End If
            rsSource.Close
            Set rsSource = Nothing
            Set qd = Nothing
            DoEvents
            .MoveNext
        Wend
        .Close
    End With
    Set rsTarget = Nothing
    Set db = Nothing
End Function