Do---Loop Error in Complex Code

[Pete T]

Evening, I have an Excel Spreedsheet which is used throughout the
Office to track assignments given to each staff member. I am now
wanting to add a worksheet which will track staff contacts and upload
that information to a Center Database (Table aready exist). I wrote
the following code to check for records already in the Database and
update them -if necessary, And also to add new records as needed. But
I continue to have Loop problems, and suggestions...



Sub DatabaseTransfer()
'
'
Dim dbs As Database
Dim rs As Recordset
Dim adjlog As String
Dim notfound As Boolean

adjlog = "\\xxxx.mdb"
Set dbs = OpenDatabase(adjlog)
Set rs = dbs.OpenRecordset("TEntry", dbOpenTable)
notfound = True
For R = 4 To 300
ColE = ActiveDocument.Cells(R, 5).Value
If ColE = "" Then
Exit For
End If
Do While Not rs.EOF
If ActiveDocument.Cells(1, 5).Value = rs.Fields("Login") _
And ActiveDocument.Cells(R, 5).Value = rs.Fields("SSN") Then
rs.Edit
rs.Fields("Login") = Range("F" & 1).Value 'Login is static
rs.Fields("From") = ActiveDocument.Cells(R, 3).Value
rs.Fields("Type") = ActiveDocument.Cells(R, 4).Value
rs.Fields("Date/Time") = ActiveDocument.Cells(R, 2).Value
rs.Fields("SSN") = ActiveDocument.Cells(R, 5).Value
rs.Fields("Claimant") = ActiveDocument.Cells(R, 6).Value
rs.Fields("OthPhone") = ActiveDocument.Cells(R, 7).Value
rs.Fields("Employer") = ActiveDocument.Cells(R, 9).Value
rs.Fields("Contact") = ActiveDocument.Cells(R, 10).Value
rs.Fields("OthEPhone") = ActiveDocument.Cells(R, 11).Value
rs.Fields("Action") = ActiveDocument.Cells(R, 12).Value
rs.Fields("Remarks") = ActiveDocument.Cells(R, 13).Value
rs.Update
notfound = False
Exit Do
Loop
Next
Else
rs.MoveNext
rs.AddNew
rs.Fields("Login") = Range("F" & 1).Value
rs.Fields("From") = ActiveDocument.Cells(R, 3).Value
rs.Fields("Type") = ActiveDocument.Cells(R, 4).Value
rs.Fields("Date/Time") = ActiveDocument.Cells(R, 2).Value
rs.Fields("SSN") = ActiveDocument.Cells(R, 5).Value
rs.Fields("Claimant") = ActiveDocument.Cells(R, 6).Value
rs.Fields("OthPhone") = ActiveDocument.Cells(R, 7).Value
rs.Fields("Employer") = ActiveDocument.Cells(R, 9).Value
rs.Fields("Contact") = ActiveDocument.Cells(R, 10).Value
rs.Fields("OthEPhone") = ActiveDocument.Cells(R, 11).Value
rs.Fields("Action") = ActiveDocument.Cells(R, 12).Value
rs.Fields("Remarks") = ActiveDocument.Cells(R, 13).Value
Dim response As Variant
response = MsgBox("New Record Added to AdjLog Record")
rs.Update
End If
rs.Close
Set rs = Nothing
dbs.Close
Set dbs = Nothing

End Sub

 

[Paul Robinson]

Hi Pete,
You seem to have your loop tangled up with your if..then and your
for..next. Is this what you mean? (I removed some of the goo to make
it easier to see what is going on)
regards
Paul

Sub DatabaseTransfer()
'
'
Dim dbs As Database
Dim rs As Recordset
Dim adjlog As String
Dim notfound As Boolean
Dim response As Variant
adjlog = "\\xxxx.mdb"
Set dbs = OpenDatabase(adjlog)
Set rs = dbs.OpenRecordset("TEntry", dbOpenTable)
notfound = True
For R = 4 To 300
ColE = ActiveDocument.Cells(R, 5).Value
If ColE = "" Then
Exit For
End If
With rs
Do While Not .EOF
If ActiveDocument.Cells(1, 5).Value = .Fields("Login") _
And ActiveDocument.Cells(R, 5).Value = .Fields("SSN") Then
.Edit
.Fields("Login") = Range("F" & 1).Value 'Login is static
'and the rest
.Update
notfound = False
Exit Do
Else
.MoveNext
.AddNew
.Fields("Login") = Range("F" & 1).Value
'and the rest
response = MsgBox("New Record Added to AdjLog Record")
.Update
End If
Loop
End with
next R
rs.Close
End with
Set rs = Nothing
dbs.Close
Set dbs = Nothing

End Sub

 

[Paul Robinson]

Hi Pete,
You seem to have your loop tangled up with your if..then. Is this what
you mean? (I removed some of the goo to make it easier to see what is
going on)
regards
Paul

Sub DatabaseTransfer()
'
'
Dim dbs As Database
Dim rs As Recordset
Dim adjlog As String
Dim notfound As Boolean
Dim response As Variant
adjlog = "\\xxxx.mdb"
Set dbs = OpenDatabase(adjlog)
Set rs = dbs.OpenRecordset("TEntry", dbOpenTable)
notfound = True
For R = 4 To 300
ColE = ActiveDocument.Cells(R, 5).Value
If ColE = "" Then
Exit For
End If
With rs
Do While Not .EOF
If ActiveDocument.Cells(1, 5).Value = .Fields("Login") _
And ActiveDocument.Cells(R, 5).Value = .Fields("SSN") Then
.Edit
.Fields("Login") = Range("F" & 1).Value 'Login is static
'and the rest
.Update
notfound = False
Exit Do
Else
.MoveNext
.AddNew
.Fields("Login") = Range("F" & 1).Value
'and the rest
response = MsgBox("New Record Added to AdjLog Record")
.Update
End If
Loop
.Close
End with
Set rs = Nothing
dbs.Close
Set dbs = Nothing

End Sub

 

[Pete T]

Thank You Paul, for your help. The code runs now, but after ColE
Variant determines there is a value in a Cells.(R,5).Value it SKIPS
over the transfer of data all the way down to Next R , back up to the
ColE , etc. Then after it reaches the end of the rows of data, it
jumps down to close. Without making any additions or edits of data in
the Database.

 

[Paul Robinson]

Hi Pete,
Definition of ColE should be
ColE = Activesheet.Cells(R,5).Value

You should also replace ActiveDocument with ActiveSheet in the rest of
your code (I didn't notice that stuff last time as I was looking at
the loops - sorry!).
The only reason I can see that things arn't being updated is if this
if..then is not being met:
If ActiveSheet.Cells(1, 5).Value = .Fields("Login") _
And ActiveSheet.Cells(R, 5).Value = .Fields("SSN") Then

Put in
MsgBox ActiveDocument.Cells(1, 5).Value = .Fields("Login") _
And ActiveDocument.Cells(R, 5).Value = .Fields("SSN")

after the If..then. If it always comes up FALSE then your condition is
not being met and your data will not update.
If the condition is met, then I don't know what the problem is. I know
nothing about Access, so don't know what the .Update method does, for
example.
Also, there was an error in the code in the first reply I sent you (I
forgot to put "Next R" near the end). Corrected in the second post.

regards
Paul

 

[Pete T]

Paul , even with the changes to ActiveSheet, the code is not looping
through the records in the Database or Spreadsheet. In stepping
through the code captures the SSN data from the Sheet then at the SSN
Field in the First recordset. If ActiveSheet.Cells(1, 5).Value =
..Fields("Login") _
And ActiveSheet.Cells(R, 5).Value = .Fields("SSN") Then
I can see that the data does not match in the first row/recordset, but
the code jumps to the Else code to Add a new record, without Looping
through each Recordset to see if there is a match.

If I attempt to move the Loop command above the Else to get the code
to loop through the Recordsets I get an error of Loop without a
Do.....