Styjun

I am running the code below to retrieve data from my Access Database into Excel. The code takes about 1 minute to execute. There are currently about 500 records with 8 columns. Is there anything I can do to modify my code to run faster?

Sub sync_Data()
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

 Dim cn As ADODB.Connection, rs As ADODB.Recordset
 Dim mysqlSt As String
 Dim rowindex As Long

 mysqlSt = "SELECT pbsclients.client, pbsclients.priority, pbsclients.source, pbsclients.lastcontact, pbsclients.result, pbsclients.nextsteps, pbsclients.attempts, pbsclients.notes FROM pbsclients; "

 Set cn = New ADODB.Connection
 With cn
 .ConnectionString = con1
 .Open
 End With

 rowindex = 2
 Set rs = New ADODB.Recordset
 rs.Open mysqlSt, cn, adOpenDynamic, adLockOptimistic

 While Not rs.EOF
 Sheet3.Cells(rowindex, 1) = rs!client
 Sheet3.Cells(rowindex, 2) = rs!Priority
 Sheet3.Cells(rowindex, 3) = rs!Source
 Sheet3.Cells(rowindex, 4) = rs!lastcontact
 Sheet3.Cells(rowindex, 5) = rs!result
 Sheet3.Cells(rowindex, 6) = rs!nextsteps
 Sheet3.Cells(rowindex, 7) = rs!attempts
 Sheet3.Cells(rowindex, 8) = rs!Notes

 rowindex = rowindex + 1
 rs.MoveNext
 Wend

 rs.Close
 Set rs = Nothing
 cn.Close
 Set cn = Nothing
 Exit Sub

 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
End Sub

Here is the working version of my code, takes about 2 seconds to run and retrieve vs 45 seconds - 1 minute with my above code.

Sub sync_Data()
 Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim mysqlSt As String
Dim rowindex As Long


mysqlSt = "SELECT pbsclients.client, pbsclients.priority, pbsclients.source, pbsclients.lastcontact, pbsclients.result, pbsclients.nextsteps, pbsclients.attempts, pbsclients.notes FROM pbsclients WHERE Id <> 0 AND pbsclients.branch = '" & Sheet3.Range("Z1") & "'"

Set cn = New ADODB.Connection

With cn
 .ConnectionString = con1
 .Open
 End With
 rowindex = 2
 Set rs = New ADODB.Recordset
 rs.Open mysqlSt, cn, adOpenDynamic, adLockOptimistic

 Do While Not rs.EOF

 Sheet3.Range("A2").CopyFromRecordset rs

 Loop

 rs.Close
 cn.Close
 Set rs = Nothing

 Set cn = Nothing
 Exit Sub
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub