Ottimizzare Routine per aggiornare tanti records

Private Sub Comando10_Click()
' Routine agganciata al pulsante di comando sulla dashboard principale...
' Elabora la tabella riferita al Fornitore ed al Cliente in linea per aggiornare le colonne di StockMonth, StockVal e SellOutVal
Dim RsTbl As DAO.Recordset ' Apro in memoria la tabella Fornitore_Cliente con tutte le settimane importate
Dim RsLP As DAO.Recordset ' Estrapolo la tabella del QLastPrice per catturare l'ultimo prezzo di acquisto
Dim RsWeeks As DAO.Recordset ' Estrapolo la tabella delle settimane per individuare quelle di fine mese
Dim RsMax As DAO.Recordset ' Estrapolo l'Ultima settimana valorizzata
Dim id_Forn As Integer
Dim id_Cl As Integer
Dim EAN As String
Dim bln_EOM As Boolean ' Se è true vuol dire che siamo in una settimana di fine mese, oppure nell'ultima settimana inserita

Dim StrMax As String
Dim strSql_LP As String
Dim strSql_Weeks As String
Dim Price_Acq As Currency ' Definisce il prezzo di acquisto del codice EAN dato Cliente e Fornitore
Dim LastN_Progr As Integer ' Definisce l'ultimo N_Progr caricato in tabella...
Dim my_Tbl As String
Dim lngCounter  As Long
Dim ReturnValue As Integer
Dim i As Long

Dim s As Single ' Registro la durata dell'Elaborazione

s = Timer

my_Tbl = Me.cbo_idFornitore.Column(1) & "_" & Me.cbo_IdCliente.Column(1)

' Apro la tabella Fornitore_Cliente con tutte le settimane caricate...
Set RsTbl = CurrentDb.OpenRecordset(Me.cbo_idFornitore.Column(1) & "_" & Me.cbo_IdCliente.Column(1))

' Il fornitore è unico per l'intera elaborazione...
id_Forn = Me.cbo_idFornitore.Value

StrMax = "SELECT Max([" & my_Tbl & "].N_PROGR) AS MaxDiN_PROGR FROM [" & my_Tbl & "];"

    Set RsMax = CurrentDb.OpenRecordset(StrMax)
    LastN_Progr = RsMax.Fields(0) ' Avrà solo un valore
    RsMax.Close
    Set RsMax = Nothing

DoCmd.Hourglass True

    lngCounter = RsTbl.RecordCount
    
    'Display message and initialize status bar:
    ReturnValue = SysCmd(acSysCmdInitMeter, "Updating Values...", lngCounter)

    Do While Not RsTbl.EOF
        i = i + 1
        ReturnValue = SysCmd(acSysCmdUpdateMeter, i) ' Visulazzo la barra di avanzamento...
        
        EAN = RsTbl![EAN]
        id_Cl = RsTbl![id_cliente]
    
        strSql_LP = _
        "SELECT Tbl_QLastPrice.IDFornitori, Tbl_QLastPrice.IDCliente, Tbl_QLastPrice.Barcode, Tbl_QLastPrice.[Prezzo Acquisto] FROM Tbl_QLastPrice " & _
        "WHERE (((Tbl_QLastPrice.IDFornitori)=" & id_Forn & ") AND ((Tbl_QLastPrice.IDCliente)=" & id_Cl & ") AND ((Tbl_QLastPrice.Barcode) = """ & EAN & """));"
        
        Set RsLP = CurrentDb.OpenRecordset(strSql_LP)
            If RsLP.RecordCount > 0 Then
                Price_Acq = RsLP![Prezzo Acquisto] ' Mi basta estrapolare il primo prezzo presente in tabella!!
            End If
        
        ' Verifico se la settimana in analisi appartiene alle settimane di fine mese...
        strSql_Weeks = "SELECT Tbl_Weeks.N_Progr, Tbl_Weeks.fineMese FROM Tbl_Weeks WHERE (((Tbl_Weeks.N_Progr)=" & RsTbl![N_Progr] & "));"
        
        Set RsWeeks = CurrentDb.OpenRecordset(strSql_Weeks)
        If RsTbl!N_Progr = LastN_Progr Or RsWeeks![finemese] = True Then
            bln_EOM = True
        Else
            bln_EOM = False
        End If
        
        RsTbl.Edit
        RsTbl!Stock_val.Value = RsTbl!Stock * Price_Acq
        RsTbl![Sell-Out_val].Value = RsTbl!SEllOut * Price_Acq
        RsTbl![Stock_Month].Value = RsTbl!Stock * bln_EOM * -1
        RsTbl!Stock_MonthVal.Value = RsTbl!Stock * Price_Acq * bln_EOM * -1
        
        RsTbl.Update
        RsTbl.MoveNext
                        
    Loop
    
DoCmd.Hourglass False

MsgBox "Durata dell'Elaborazione " & Round(Timer - s, 2)
ReturnValue = SysCmd(acSysCmdRemoveMeter)

RsTbl.Close
RsWeeks.Close
RsLP.Close

Set RsTbl = Nothing
Set RsWeeks = Nothing
Set RsLP = Nothing

End Sub