Hi
Throwing in the line

DoEvents

is often helpful. Put it at the bottom of your loop.
regards
Paul

On Aug 31, 1:37*pm, wrote:
I am trying to read and then update an Access Database using Excel VBA
code. *When I run the code below on a PC that has XP/Excel & Access
2003 - it works fine. *When I run the same code on my home computer -
which has VISTA/Excel & Access 2007 - it fails with a "Microsoft
Database Engine Stopped because you and another user are attempting to
change the same data at the same time" error.

BUT - when I step through the code - it works fine, so the problem has
something to do with the Code executing too fast for the ODBC
connection??? *Not sure if it is VISTA, or if it has something to do
with the 2007 version of EXCEL or ACCESS.

Has anyone else run into this?? *And/or does anyone have a solution as
to how I could slow it all down, so it works.

HELP.......

Dim rs As Recordset
Set rs = CreateObject("ADODB.Recordset")
Dim rs2 As Recordset
Set rs2 = CreateObject("ADODB.Recordset")
Dim rsTeam As Recordset
Set rsTeam = CreateObject("ADODB.Recordset")
Dim rsIce As Recordset
Set rsIce = CreateObject("ADODB.Recordset")
Dim sLevel As String
Dim sSql As String
Dim sSql2 As String
Dim sSqlUpdt1 As String
Dim sSqlUpdt2 As String
Dim sNov As Integer
Dim sDec As Integer
Dim sJan As Integer
Dim sFeb As Integer
Dim sMar As Integer
Dim sIceMax As Integer
Dim sMoAvg *As Integer
Dim sLastDt As Date
Dim sLvlCnt As Integer
Dim sAlldone As Boolean
Dim sTeam As String
Dim sIceCnt As Integer
Dim sEventStart As Date
Dim sHrsDone As Boolean
Dim sOrder As Integer

sAlldone = False
sTime = "#12/30/1899 8:0:0#"
sHrsDone = False

Do Until sAlldone
* * sSql2 = "SELECT SchedDate, EventStart, Home, home_level,
Event_Type " & _
* * * * "FROM Initiation_ice " & _
* * * * "WHERE home = '' " & _
* * * * "AND EventStart < " & sTime & _
* * * * " order by schedDate" & ";"
* * With rsIce
* * * * .Source = sSql2
* * * * .ActiveConnection = "ice_scheduling"
* * * * .CursorType = adOpenStatic
* * * * .LockType = adLockOptimistic
* * * * .Open
* * * * If rsIce.RecordCount = 0 Then
* * * * * * sAlldone = True
* * * * * * rsIce.Close
* * * * Else
* * * * * * res = rsIce.GetRows
* * * * * * lrows = UBound(res, 2)

* * * * * * r = 0
* * * * * * sIceDate = res(0, r)
* * * * * * sMonth = Month(sIceDate)
* * * * * * sMonthName = MonthName(sMonth)

* * * * * * sSql = "SELECT Team, Hours_rcvd, max_hrs, hours_complete,
assign_order, team_information.level, " & _
* * * * * * * * * * "nov_hrs, dec_hrs, jan_hrs, feb_hrs, mar_hrs " & _
* * * * * * * * * * "FROM team_information " & _
* * * * * * * * * * "WHERE hours_complete = " & sHrsDone & _
* * * * * * * * * * " order by hours_rcvd, assign_order" & ";"
* * * * * * With rsTeam
* * * * * * * * .Source = sSql
* * * * * * * * .ActiveConnection = "ice_scheduling"
* * * * * * * * .CursorType = adOpenStatic
* * * * * * * * .LockType = adLockOptimistic
* * * * * * * * .Open
* * * * * * * * If rsTeam.RecordCount = 0 Then
* * * * * * * * * * sAlldone = True
* * * * * * * * * * rsTeam.Close
* * * * * * * * Else
* * * * * * * * * * res = rsTeam.GetRows
* * * * * * * * * * lrows = UBound(res, 2)

* * * * * * * * * * r = 0
* * * * * * * * * * * * sTeam = res(0, r)
* * * * * * * * * * * * sIceCnt = res(1, r)
* * * * * * * * * * * * sIceMax = res(2, r)
* * * * * * * * * * * * sOrder = res(4, r)
* * * * * * * * * * * * sLevel = res(5, r)
* * * * * * * * * * * * sIceCnt = sIceCnt + 1
* * * * * * * * * * * * sNov = res(6, r)
* * * * * * * * * * * * sDec = res(7, r)
* * * * * * * * * * * * sJan = res(8, r)
* * * * * * * * * * * * sFeb = res(9, r)
* * * * * * * * * * * * sMar = res(10, r)
* * * * * * * * * * * * If sMonthName = "November" Then
* * * * * * * * * * * * * * sNov = sNov + 1
* * * * * * * * * * * * Else
* * * * * * * * * * * * * * If sMonthName = "December" Then
* * * * * * * * * * * * * * * * sDec = sDec + 1
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * If sMonthName = "January" Then
* * * * * * * * * * * * * * * * * * sJan = sJan + 1
* * * * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * * * If sMonthName = "February" Then
* * * * * * * * * * * * * * * * * * * * sFeb = sFeb + 1
* * * * * * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * * * * * sMar = sMar + 1
* * * * * * * * * * * * * * * * * * End If
* * * * * * * * * * * * * * * * End If
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If

* * * * * * * * * * With rsTeam
* * * * * * * * * * * * If .EOF Then
* * * * * * * * * * * * * * .MoveFirst

* * * * * * * * * * * * * * If sIceCnt = sIceMax Then
* * * * * * * * * * * * * * * * .Fields(3).Value = True
* * * * * * * * * * * * * * * * .Fields(1).Value = sIceCnt
* * * * * * * * * * * * * * * * .Fields(6).Value = sNov
* * * * * * * * * * * * * * * * .Fields(7).Value = sDec
* * * * * * * * * * * * * * * * .Fields(8).Value = sJan
* * * * * * * * * * * * * * * * .Fields(9).Value = sFeb
* * * * * * * * * * * * * * * * .Fields(10).Value = sMar
* * * * * * * * * * * * * * * * .Update
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * .Fields(1).Value = sIceCnt
* * * * * * * * * * * * * * * * .Fields(6).Value = sNov
* * * * * * * * * * * * * * * * .Fields(7).Value = sDec
* * * * * * * * * * * * * * * * .Fields(8).Value = sJan
* * * * * * * * * * * * * * * * .Fields(9).Value = sFeb
* * * * * * * * * * * * * * * * .Fields(10).Value = sMar
* * * * * * * * * * * * * * * * .Update
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If

* * * * * * * * * * End With

* * * * * * * * * * rsTeam.Close

* * * * * * * * End If
* * * * * * End With
* * * * * * If sAlldone = False Then
* * * * * * * * With rsIce
* * * * * * * * * * If .EOF Then
* * * * * * * * * * * * .MoveFirst
* * * * * * * * * * * * .Fields(2).Value = sTeam
* * * * * * * * * * * * .Fields(3).Value = sLevel
* * * * * * * * * * * * .Fields(4).Value = "Practice"
* * * * * * * * * * * * .Update
* * * * * * * * * * End If
* * * * * * * * End With
* * * * * * End If

* * * * * * rsIce.Close

* * * * End If
* * End With
Loop

End Sub