# Extremely Slow VBA Code - Update Access via Excel



## excelnewcomer123 (Feb 22, 2016)

I found a code that I have edited to update access records via Excel (Code below). I have tested it and it works perfectly, however it takes 3 minutes to update 6 records (rows). Is there any way to fix this and make it much faster?

The code searches for the primary key in an excel row, and updates fields 9-12 for that uniqueID to access. Realistically, I only need rows that were edited after the latest save to be updated, but my VBA knowledge is limited and I do not know how to do this, let alone if it is possible.


```
Sub UpdateAccess() 
 On Error Resume Next
 
Application.ScreenUpdating = False    ' Prevents screen refreshing.

Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngID, LR, Upd
Dim j As Long
Dim sSQL As String

Const TARGET_DB = "Access Database.accdb"

LR = Range("A" & Rows.Count).End(xlUp).Row
Upd = LR - 1

lngRow = 1
Do While lngRow <= LR

lngID = Cells(lngRow, 13).Value

sSQL = "SELECT * FROM QuoteDatabase WHERE UniqueID = " & [lngID]

Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn

End With

Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic

'Load all records from Excel to Access.
With rst

.Fields("Field9") = Cells(lngRow, 9).Value
.Fields("Field10") = Cells(lngRow, 10).Value
.Fields("Field11") = Cells(lngRow, 11).Value
.Fields("Field12") = Cells(lngRow, 12).Value

rst.Update
End With

' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing

lngRow = lngRow + 1

Loop

MsgBox "You just updated " & Upd & " records"
End Sub
```

thank you


----------



## CalcSux78 (Feb 23, 2016)

How many records (on average) are you updating?  It looks like each loop updates 4 fields for each record. 

If you have a large set of records that you are updating, that could explain part of the slowness.  If it's only 1 record updating 4 fields for the entire sub, I'm not sure if modifying your code will give you the performance jump you're looking for.  I would question the location of the Access database file.  It sounds like it may be located on a remote server that isn't in your physical location (which will slow down the process).


----------



## excelnewcomer123 (Feb 23, 2016)

It's a log, so the number of records will grow exponentially once this utilized. Right now excel has only 6 records and it is very slow. Both the database and the excel are on a remote, shared drive. 
I'm wondering if there is a different way then to perform the similar task? Is there a way to only update records that were changed after the last update? (so instead of updating every record, every time - it would only update a handful?
Or possibly it is faster to copy all rows with a value in fields 9-12 and paste them over the existing access database? (since the excel is an exported table from access anyways)

I seem to be reading that there is no easy way to link back and forth due to a lawsuit MS encountered a few years back. Access licenses are limited, so I am trying to make everything doable via excel



Thank you for your time


----------



## excelnewcomer123 (Feb 23, 2016)

Is this something that can be a batchupdate or recordset Update instead? I dont understand either very well, but have come across them in research. If so, how would I go about changing that?


----------



## CalcSux78 (Feb 23, 2016)

I would use the Worksheet_Change event to trigger your code to run.  Then, you'd be able to target exactly which single record needs to change.  

I can give a more detailed example if you can give some info:


Table Name of your MS Access table.
Field Names - (The header row of your table in MS Access) 
Add or Update?  (Will you only update records or would you ever use this to create a new record?)
Does your spreadsheet contain any external data from the database?


----------



## excelnewcomer123 (Feb 24, 2016)

So it would update the record as it is changed?

-Table name of MS access = QuoteDatabase
-Field Names = Field1, Field2, Field3, Field4, Field5, Field6, Field7, Field8, Field9, Field10, Field11, Field12, UniqueID
-Will only be updating fields 9-12 
-The entire 13 rows are automatically refreshing, upon open, in excel FROM the access table, "quotedatabase" (i have created an external link)

Hope that helps - thank you again!


----------



## CalcSux78 (Feb 24, 2016)

This is un-tested, but should get you going in the right direction.


```
'Place this code on the Sheet object level containing data to send
Const MyConn As String = "Data Source=" & ThisWorkbook.Path & _
                    Application.PathSeparator & "Access Database.accdb;"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Dim ssql As String, tbl As String
Dim lngID As Long
Dim lngRow As Long

On Error GoTo WrapUp        'disable this line if you need to error test code

Const MyConn As String = "Data Source=" & ThisWorkbook.Path & _
                    Application.PathSeparator & "Access Database.accdb;"
                    
tbl = "QuoteDatabase"
lngRow = Target.Row
lngID = Cells(lngRow, 13).Value

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & MyConn
ssql = "SELECT * FROM " & tbl & " WHERE " & tbl & ".UniqueID=" & lngID

With rs
    .Open Source:=ssql, ActiveConnection:=cn, CursorType:=adOpenKeyset, _
        LockType:=adLockOptimistic, Options:=adCmdTableDirect
    .Fields("Field9") = Cells(lngRow, 9).Value
    .Fields("Field10") = Cells(lngRow, 10).Value
    .Fields("Field11") = Cells(lngRow, 11).Value
    .Fields("Field12") = Cells(lngRow, 12).Value
    'repeat for all required fields
    .Update
    .Close
End With

WrapUp:         'return here on error to close connections

Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
```


----------



## excelnewcomer123 (Feb 26, 2016)

This is great, thank you very much. The only  change I had to make is that the Const statement cannot be dynamic content, so i had to change that - solution being in this thread

Compile Error: Constant Expression Required. Passing String to Constant


----------



## CalcSux78 (Feb 26, 2016)

Glad it worked... on the error, I guess Cunningham's Law held up on it!


----------



## afrpompeia (Mar 7, 2019)

I dont know if this is a correct place. If not, tell me how to post similar problem but on local machine with access and excel 2010
*I made a excel procedure to test for extremely slow vba to access into a command button;*
*Here is my code:*
Public Sub abretabela(ByVal rs As ADODB.Recordset, ByVal squery As String)
On Error GoTo AbreError
With rs
     .Source = squery
     Set .ActiveConnection = conn
     .CursorType = adOpenDynamic
     .LockType = adLockPessimistic
     .CursorLocation = adUseClient
     .Open
End With
AbreError:
    If Err.Number <> 0 Then
       MsgBox "Erro - " & Err.Description
      ' Resume
    End If
End Sub

Public Sub CloseConnection()
    conn.Close
    Set conn = Nothing
End Sub

Public Sub OpenConnection()
    Dim strDbPath As String
    strDbPath = ThisWorkbook.Path
    'conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & strDbPath & "\CriaQuestoes1.accdb"
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDbPath & "\CriaQuestoes2.21.accdb"
    conn.Open
End Sub

Private Sub CommandButton1_Click()
    Dim squery As String
    Dim i As Integer
    Dim s1(1 To 5) As String
    Dim s2(1 To 5) As String
    Dim s3(1 To 5) As String
    Dim i1(1 To 5) As Integer
    Dim i2(1 To 5) As Integer
    Dim L1(1 To 5) As Long
    On Error GoTo errao
    LerRegistroBD
    s1(1) = 534: s1(2) = 654: s1(3) = 765: s1(4) = 876: s1(5) = "888"
    s2(1) = "Alvaro": s2(2) = "Angela": s2(3) = "Carina": s2(4) = "Marina": s2(5) = "martha"
    s3(1) = "Silva": s3(2) = "Gomes": s3(3) = "Ramos": s3(4) = "Souza": s3(5) = "Santos"
    i1(1) = 6: i1(2) = 12: i1(3) = 14: i1(4) = 18: i1(5) = 24
    i2(1) = 551: i2(2) = 1854: i2(3) = 2554: i2(4) = 3368: i2(5) = 5899
    L1(1) = 54287426: L1(2) = 94875412: L1(3) = 14587414: L1(4) = 20540489: L1(5) = 54874526:
    For i = 1 To 5
    ´-----------------------------------------  
*      OpenConnection*
*    ´-------------------------------------------*
        conn.BeginTrans
        squery = "UPDATE Employee SET empid ='" & s1(i) & "'"
        squery = squery & ",fname ='" & s2(i) & "',lname ='" & s3(i)
        squery = squery & "',idade=" & i1(i) & ",anon=" & i2(i)
        squery = squery & ",fones=" & L1(i) & " WHERE Código=1;"
        Debug.Print squery
        abretabela rs, squery
        conn.CommitTrans
        If (rs.State And adStateOpen) = adStateOpen Then
            rs.Close
            Set rs = Nothing
        End If
        CloseConnection
    Next
erraoexit:
    Exit Sub
errao:
    MsgBox Err.Number & " " & Err.Description
    Resume 'erraoexit
End Sub

Private Sub LerRegistroBD()
    Dim squery As String
    On Error GoTo errado
    squery = "Select empid,fname,lname,idade,anon,fones from Employee WHERE código=1;"
     OpenConnection
     conn.BeginTrans
     abretabela rs, squery
     Debug.Print rs.Fields("empid") & "-" & rs.Fields("fname") & "-" & rs.Fields("lname") & "-" & rs.Fields("idade") & "-" & rs.Fields("anon") & "-" & rs.Fields("fones") & " WHERE código=1"
     conn.CommitTrans
     rs.Close
     Set rs = Nothing
     CloseConnection
erradoexit:
    Exit Sub
errado:
    MsgBox Err.Number & " " & Err.Description
    Resume erradoexit
End Sub

The table employee:
Código automatic, empId text(10),fname text(40),lname text(40),idade integer,anon integer,fones long.
Executing with F5 stopping between dashed line and looking the table on access,  the employee table was updated 10 to 20 seconds after closing connections. Is there a way to update the record immediately?
(sorry, english is not my native language)


----------

