title: Updating Access 2010 Table from Excel VBA Only updates only one record
body: <p>Having quite a time trying to update an access table from excel.  I am using ADOB Connection and looping through spreadsheet that has the updates.  This can be anywhere from 200 records to 1000 + records.  </p>
  
  <p>When running the following code It will only update one record in the access table despite showing it has updated 1047 records from my test data.</p>
  
  <p>I am updating a sales record that has 62 columns. The Column "BI" is the unique ID generated upon quoting.  What the update is specifying is to change Data in the QorB Column from Q to B based upon the ID in Column "BI" (sQID)</p>
  
  <p>After the module runs it shows that it has updated 1047 records from this but when opening the access DB it shows only one record changed.. I am at a loss.</p>
  
  <p>Can anyone see anything drastically wrong with the below code?  is there a better way to update access with a large amount of data from excel? </p>
  
  <pre><code>Sub updatedbtest2()
  
  Dim cn As ADODB.Connection, rs As ADODB.Recordset
  Dim rng As Range
  Dim lngRow As Long
  Dim lngID, LR, Upd
  Dim sSQL As String
  
  'Get Last Row of range used 
  LR = Range("BI" &amp; Rows.Count).End(xlUp).Row
  
  Upd = LR - 1   
  lngRow = 2    
  Do While lngRow &lt;= LR
  lngID = Cells(lngRow, 61).Value   
  
      Set cn = New ADODB.Connection
      cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" &amp; _
      "Data Source=C:\Database\sales.accdb;"
  
  sQID = Cells(2, 61).Value
  
      Set rs = New ADODB.Recordset
  
         sSQL = "SELECT * FROM P&amp;R WHERE QuoteID ='" &amp; sQID &amp; "';"  
  
  rs.Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic
  
          ' update fields within table with values from spreadsheet.
          With rs
              .Fields("QorB") = Cells(lngRow, 60).Value
              .Fields("BDate") = Cells(lngRow, 62).Value
              .update
          End With        
      rs.update   
     'Next rng
  
  lngRow = lngRow + 1
  
      rs.Close
      Set rs = Nothing
      cn.Close
      Set cn = Nothing       
  
  
  Loop
  
  MsgBox "You just updated " &amp; Upd &amp; " records"
  End Sub
  </code></pre>
  
  <p>Thanks For taking a look at this. </p>
  
  <p>I have made the following changes to the code from suggestions with the same exact results. </p>
  
  <p><a href="http://i.stack.imgur.com/zrTzs.jpg" rel="nofollow">Snip of Access showing records</a></p>
  
  <pre><code>Sub updatedbtest2()
  
  Dim cn As ADODB.Connection, rs As ADODB.Recordset
  Dim rng As Range
  Dim lngRow As Long
  Dim sQID, LR
  Dim sSQL As String
  
  LR = Range("A" &amp; Rows.Count).End(xlUp).Row
  Debug.Print LR
  
  
  Upd = LR - 1
  lngRow = 2
  sQID = Cells(lngRow, 61).Value
  
  'Do While lngRow &lt;= LR
  
      Set cn = New ADODB.Connection
      cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" &amp; _
      "Data Source=C:\Database\sales.accdb;"
  
      Set rs = New ADODB.Recordset
  
         sSQL = "SELECT * FROM PandR WHERE QID ='" &amp; sQID &amp; "';"
  
      rs.Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic
  
          Do While lngRow &lt;= LR
  
          With rs
              .Fields("QorB") = Cells(lngRow, 60).Value
              .Fields("BDate") = Cells(lngRow, 62).Value
              .update
  
          End With
  
      'Next rng
      lngRow = lngRow + 1       
  
      Loop    
  
      rs.Close
      Set rs = Nothing
      cn.Close
      Set cn = Nothing
  
  End Sub
  </code></pre>