I have the following piece of code :
Code:
    Dim Xls As Object
    Dim Rs As Variant
    Dim i As Integer

    Set Xls = CreateObject("Excel.application")
    Xls.Workbooks.Open "C:\Prices.xls"
    Set Rs = DB.OpenRecordset("DBPrices")
   


For i = 1 To 150
    Rs.MoveFirst
    Do While Not Rs.EOF
        If Xls.Worksheets("sheet1").Cells(i, 1).Value = Rs!Chocky_Bar Then
                With Rs
                    .Edit
                    !price = Worksheets("sheet1").Cells(i, 2).Value
                    .Update
                    TxtWait.Text = "Updated Excel record number    " & i & _
                    "into Access database" & vbCrLf
                End With
                Exit Do
        Else
                Rs.MoveNext
        End If
    Loop
Next i

MsgBox "The Prices of chocky bars have been updated", _
vbOKOnly + vbInformation, "Finished !"

    Xls.Quit
    Set Xls = Nothing
    Set Qdprice = Nothing
Brief intro :
This checks an Excel cell, and looks throughout column1 in an Access database for the same entry. If the entries found, the Excell cell to the right of the selected one has the data copied to the right of the selected Access recordset. If the data isn't found, the loop checks the other recordsets / column cells in the access database.

Question
This is taking ages to perform the calculation. Is there anything I can do to speed this code up please?