I had a similar problem but I only have one user and one sheet. Here is the code:
/*
Sub AlterAllRecords()
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
LR = Range("A" & Rows.Count).End(xlUp).Row
Upd = LR - 6
lngRow = 6
Do While lngRow <= LR
lngID = Cells(lngRow, 1).Value
sSQL = "SELECT * FROM Base WHERE (((Base.[PO])=" & "'" & lngID & "'" & "));"
Set cnn = New ADODB.Connection
'MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
MyConn = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = S:\Public Folder\DanielleSN\Steel Needs 1209.accdb"
With cnn
' .Provider = "Microsoft.Jet.OLEDB.4.0"
.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.
' rst(Cells(1, j).Value) = Cells(lngRow, j).Value
'Next j
With rst
.Fields("PO") = Cells(lngRow, 1).Value
.Fields("Vendor") = Cells(lngRow, 2).Value
.Fields("ShiptoName") = Cells(lngRow, 3).Value
.Fields("ShiptoADDR") = Cells(lngRow, 4).Value
.Fields("ShiptoCITY") = Cells(lngRow, 5).Value
.Fields("SHIPVIA") = Cells(lngRow, 6).Value
.Fields("FOB") = Cells(lngRow, 7).Value
.Fields("WEIGHT") = Cells(lngRow, 8).Value
.Fields("GRADE") = Cells(lngRow, 9).Value
.Fields("GAUGE") = Cells(lngRow, 10).Value
.Fields("WIDTH") = Cells(lngRow, 11).Value
.Fields("LENGTH") = Cells(lngRow, 12).Value
.Fields("COST-MATL") = Cells(lngRow, 13).Value
.Fields("SlitTo-Part") = Cells(lngRow, 14).Value
.Fields("P-ODate") = Cells(lngRow, 15).Value
.Fields("CUSTOMER") = Cells(lngRow, 16).Value
.Fields("TagDesc") = Cells(lngRow, 17).Value
.Fields("Rockwell") = Cells(lngRow, 18).Value
.Fields("Vendor Acknowledgement") = Cells(lngRow, 19).Value
.Fields("Po Status and/or Update") = Cells(lngRow, 20).Value
.Fields("Estimated ready date") = Cells(lngRow, 21).Value
.Fields("Released by vendor?") = Cells(lngRow, 22).Value
.Fields("POStatus") = Cells(lngRow, 23).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
*/
What I do is count the number of rows (LR - 6). I have header records in the first 6 rows.
Then I set up the sql statement that will locate the single record that I want to update.
Now you open the database and recordset
Then I update the records with each cell. I basically establish a relationship between a cell and a field in Access. Once it is all built then it updates.
I keep looping until I have reached the last row and I close. I added a you just updated X number of records but I am finding it is more annoying than helpful.
You need to close the connection and reopen it every time. I am usually updating about 100 - 200 records and it takes about 4 seconds. I was trying to find out if it needs to be updated and then found it was easier to just do them all.
HTH
