Guru one - speed of this code ...

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?

Only need a single loop, not nested with your RS.

Code:

---

For i = 1 To 150
    strSQL = "UPDATE DBPrices " & _
            "SET price = " & Worksheets("sheet1").Cells(i, 2).Value & " " & _
            "WHERE Chocky_Bar = '" & Xls.Worksheets("sheet1").Cells(i, 1).Value & "'"
           
    '// Execute the strSQL against your DB connection here  //

Next i

---

:cool:

Thank you Jerry!

Please could you further this one though. The above was a altered example of the following I am using to try & copy this data.

Code:

---

    For i = 1 To 284
        Qdprice.MoveFirst
        StrSQL = "UPDATE Price_Uploader SET price= " & Worksheets("sheet1").Cells(i, 2).Value & " " & _
            "WHERE partnumber = '" & Xls.Worksheets("sheet1").Cells(i, 1).Value & "'"
          With Qdprice
                .Edit
                !price = Worksheets("sheet1").Cells(i, 2).Value
                .Update
                TxtWait.Text = TxtWait.Text & "Updated Excel record number  " & i & "  into Pours database" & vbCrLf & ""
            End With
    Next i

---

I'm not quite sure what I have done, but this only updates the Access entry which matches the first Excel cell, doesn't go down the cells.

Thank you.

add a reference to ADO (Microsoft ActiveX Data Objects 2.1 Library) or greater, to your project. Then use the following

Code:

---


Dim ASTcn As New ADODB.Connection
Dim Xls As Object
Dim Rs As Variant
Dim i As Integer

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

ASTcn.ConnectionTimeout = 5
ASTcn.Open "Driver={Microsoft Access Driver (*.MDB)};DefaultDir=C:\Databases;Uid=;Pwd=;Dbq=MyData.MDB"
If ASTcn.State = 0 then
    '// No connection, so handle exit.
End if

For i = 1 To 150
    strSQL = "UPDATE DBPrices " & _
            "SET price = " & Xls.Worksheets("sheet1").Cells(i, 2).Value & " " & _
            "WHERE Chocky_Bar = '" & Xls.Worksheets("sheet1").Cells(i, 1).Value & "'"
           
    ASTcn.BeginTrans
    ASTcn.Execute strSQL
    '// Handle any error with a rollback here
    '// If Err = -2147168237 Then ASTcn.RollbackTrans: Resume
    ASTcn.CommitTrans


Next i

ASTcn.Close

---

All you need is a change the connection string.

:cool: