I am having problems with updating records in MS Access through Excel macro (coded in VBA).

I'll try to explain better what's the issue:

I created a UserForm to input the information inserted in several ListBoxes (populated by strings) into an MS Access database. The 1st loop is checking if each element of the ListBox1 is already present in the database and, if it's not, it's inserting it in. The elements from the ListBox2 could either be the same or differ from the one from the 1st. Therefore, I am performing the "Access.Application.DCount" to avoid errors related to duplicate entries. Always in the 2nd loop, if the element has already been inserted in the database, I just run an "UPDATE" query to check a CheckBox; if the element is not found in the database, I run the "INSERT INTO" query to create the new record.

The issue I am experiencing is that - since the loops are running one right after the other - MS Access is taking a long time to update the entries (around 5 seconds). Thus - when the 2nd loop runs - only the "INSERT INTO" query is executed, even if the elements are exactly the same as the ones inserted in the 1st loop. This explains is the reason of the following lines of code:

'Wait for the database to update
cnt.Update
Application.Wait Now + #12:00:05 AM#

If I wait those 5 seconds before running the 2nd loop, then the elements from the 1st loop are recorded in the database and I have no problems with the 2nd loop. However, I cannot afford to waste all this time waiting for the MS Access to refresh. I need to run several couples of similar loops, and the waiting time is extending too far.

Is there a way to optimise my code and/or to speed up the information tranfer between Excel and Access?

I am pasting the 2 loops here:

For X = 0 To ListBox1.ListCount - 1
    'Look for duplicates
    If ((Access.Application.DCount("*", "Table1", "ID ='" & IdentificationCode & "' AND DWG = '" & ListBox1.List(X) & "'") > 0) Or IsNull(ListBox1.List(X)) = True) Then
        'MsgBox "Element already in the DB"
    Else
        On Error Resume Next
        
        'Insert the data into the recordset
        insert1 = "insert into Table1(" _
        & "ID," _
        & "DWG," _
        & "CheckBox1)" _
        & "values(" _
        & "'" & IdentificationCode & "'," _
        & "'" & ListBox1.List(X) & "'," _
        & "-1)"
        
        cnt.Execute (insert1)
    End If
Next X

If (ListBox2.ListCount > 0) Then
    'Wait for the database to update
    cnt.Update
    Application.Wait Now + #12:00:05 AM#

    For X = 0 To ListBox2.ListCount - 1
        'Look for duplicates
        If ((Access.Application.DCount("*", "Table1", "ID ='" & IdentificationCode & "' AND DWG = '" & ListBox2.List(X) & "'") > 0)) Then 'Or IsNull(ListBox2.List(X)) = True)
            'MsgBox "Element already in the DB"
            On Error Resume Next
            
            update1 = "update Table1 set" _
            & "[Table2].CheckBox2 ='-1'" _
            & "where [Table2].ID ='" & IdentificationCode & "'" _
            & "and [Table2].DWG ='" & ListBox2.List(X) & "';"
            
            cnt.Execute (update1)
        Else
            On Error Resume Next
            
            'Insert the data into the recordset
            insert2 = "insert into Table1(" _
            & "ID," _
            & "DWG," _
            & "CheckBox2)" _
            & "values(" _
            & "'" & IdentificationCode & "'," _
            & "'" & ListBox2.List(X) & "'," _
            & "-1)"
            
            cnt.Execute (insert2)
        End If
    Next X
End If

Obviously, this is not the full code. Before getting to the loops I am setting the "ADODB.Connection" and opening it.

I would like to underline the fact that this code returns no error. It is doing what is supposed to do. My question here is what can I do to avoid waiting those 5 seconds?

Thank you in advance for your time and support! Hope you can help me with that.

I am having problems with updating records in MS Access through Excel macro (coded in VBA).

I'll try to explain better what's the issue:

I created a UserForm to input the information inserted in several ListBoxes (populated by strings) into an MS Access database. The 1st loop is checking if each element of the ListBox1 is already present in the database and, if it's not, it's inserting it in. The elements from the ListBox2 could either be the same or differ from the one from the 1st. Therefore, I am performing the "Access.Application.DCount" to avoid errors related to duplicate entries. Always in the 2nd loop, if the element has already been inserted in the database, I just run an "UPDATE" query to check a CheckBox; if the element is not found in the database, I run the "INSERT INTO" query to create the new record.

The issue I am experiencing is that - since the loops are running one right after the other - MS Access is taking a long time to update the entries (around 5 seconds). Thus - when the 2nd loop runs - only the "INSERT INTO" query is executed, even if the elements are exactly the same as the ones inserted in the 1st loop. This explains is the reason of the following lines of code:

'Wait for the database to update
cnt.Update
Application.Wait Now + #12:00:05 AM#

If I wait those 5 seconds before running the 2nd loop, then the elements from the 1st loop are recorded in the database and I have no problems with the 2nd loop. However, I cannot afford to waste all this time waiting for the MS Access to refresh. I need to run several couples of similar loops, and the waiting time is extending too far.

Is there a way to optimise my code and/or to speed up the information tranfer between Excel and Access?

I am pasting the 2 loops here:

For X = 0 To ListBox1.ListCount - 1
    'Look for duplicates
    If ((Access.Application.DCount("*", "Table1", "ID ='" & IdentificationCode & "' AND DWG = '" & ListBox1.List(X) & "'") > 0) Or IsNull(ListBox1.List(X)) = True) Then
        'MsgBox "Element already in the DB"
    Else
        On Error Resume Next
        
        'Insert the data into the recordset
        insert1 = "insert into Table1(" _
        & "ID," _
        & "DWG," _
        & "CheckBox1)" _
        & "values(" _
        & "'" & IdentificationCode & "'," _
        & "'" & ListBox1.List(X) & "'," _
        & "-1)"
        
        cnt.Execute (insert1)
    End If
Next X

If (ListBox2.ListCount > 0) Then
    'Wait for the database to update
    cnt.Update
    Application.Wait Now + #12:00:05 AM#

    For X = 0 To ListBox2.ListCount - 1
        'Look for duplicates
        If ((Access.Application.DCount("*", "Table1", "ID ='" & IdentificationCode & "' AND DWG = '" & ListBox2.List(X) & "'") > 0)) Then 'Or IsNull(ListBox2.List(X)) = True)
            'MsgBox "Element already in the DB"
            On Error Resume Next
            
            update1 = "update Table1 set" _
            & "[Table2].CheckBox2 ='-1'" _
            & "where [Table2].ID ='" & IdentificationCode & "'" _
            & "and [Table2].DWG ='" & ListBox2.List(X) & "';"
            
            cnt.Execute (update1)
        Else
            On Error Resume Next
            
            'Insert the data into the recordset
            insert2 = "insert into Table1(" _
            & "ID," _
            & "DWG," _
            & "CheckBox2)" _
            & "values(" _
            & "'" & IdentificationCode & "'," _
            & "'" & ListBox2.List(X) & "'," _
            & "-1)"
            
            cnt.Execute (insert2)
        End If
    Next X
End If

Obviously, this is not the full code. Before getting to the loops I am setting the "ADODB.Connection" and opening it.

I would like to underline the fact that this code returns no error. It is doing what is supposed to do. My question here is what can I do to avoid waiting those 5 seconds?

Thank you in advance for your time and support! Hope you can help me with that.

• excel
• vba
• performance
• ms-access
• sql-update

• 1 "this code returns no error" - it has multiple On Error Resume Next though, so how would you know if there was a problem? – Tim Williams Commented Nov 19, 2024 at 17:18
• How many records in Table1, and how many items in each listbox? – Tim Williams Commented Nov 19, 2024 at 17:32
• Does final table actually have CheckBox1 and CheckBox2? – Parfait Commented Nov 19, 2024 at 19:34
• @TimWilliams I tried to run the code without the On Error Resume Next before posting it here and it returns no error. Legit observation, though! At the present time there are 15 records in Table1. However, this number is suppose to increase gradually. – busynessman Commented Nov 20, 2024 at 9:00
• @Parfait yes, the final table actually have the 2 checkboxes with a Yes/No field's data type. – busynessman Commented Nov 20, 2024 at 9:02

2 Answers 2

Consider using a staging temp table with similar structure as final destination table.

1. Make-Table Query (run once)

   SELECT TOP 1 * INTO myTempTable FROM myFinalTable
   

   Delete Query (run routinely)

   DELETE FROM myTempTable
   

2. Via a single For loop, insert all data as is. Ideally, use cleaner parameters and not messy string concatenation. Search parameter handling using ADODB Command or DAO QueryDef with many SO posts.

   INSERT INTO myTempTable (ID, DWG, CheckBox1, CheckBox2)
   VALUES (?, ?, -1, -1)
   

3. Finally, run two separate action queries using temp table by matches and non-matches:

   UPDATE matches

   UPDATE myFinalTable f 
   INNER JOIN myTempTable t
      ON f.ID = t.ID
      AND f.DWG = t.DWG
   SET f.CheckBox2 = -1
   

   INSERT non-matches

   INSERT INTO myFinalTable (ID, DWG, CheckBox2)
   SELECT t.ID, t.DWG, t.Checkbox2
   FROM myTempTable t
   LEFT JOIN myFinalTable f
      ON f.ID = t.ID
      AND f.DWG = t.DWG
   WHERE f.ID IS NULL
   

You can skip DCount and the call for an update/insert for each listbox entry:

• Open the recordset (Table1)
• Loop the listbox entries and:
  • Search for the ID
    • If found, update the record
    • If not found, insert the record
• Close the recordset