Update recordset

[barbarao]

Hi, I hope someone can help me. Everything works fine with this code except it won't update the recordset. Any thoughts? I've done about everything I can think of and can't find any help on the Web.

Private Sub cmdUpdate_SortOverall_Click()
   Dim Sqlstr As String
   Dim OSS As Integer, Diab As Integer, CVD As Integer, HT As Integer, new_sort As Double, old_sort As Double
   Dim Num_Measures As Integer
   Dim Update_Response As VbMsgBoxResult
   Dim tmpSQL As String
   Dim field_list As String
   Dim rs As ADODB.Recordset
 
   Dim cmd As ADODB.Command
   Dim cnn As New ADODB.Connection
 
    Set cnn = CurrentProject.Connection
    Set cmd = New ADODB.Command
 
 On Error GoTo Err_cmdUpdate_SortOverall
 
field_list = Allfields_except_ID("PracticeTable", "PracticeID")
 
Screen.MousePointer = 11
'01 april 2013 Practice ID and PracticeID removed as field no longer in table
 
     Sqlstr = "         Select PracticeTable.OPNumber," 'PracticeTable.[Practice ID], PracticeTable.PracticeID, PracticeTable.OPNumber, "
     Sqlstr = Sqlstr & "  PracticeTable.PracticeName, PracticeTable.ChangeID, "
     Sqlstr = Sqlstr & "  PracticeTable.OSSDisplay, PracticeTable.OSSScore, "
     Sqlstr = Sqlstr & "  PracticeTable.DMDisplay , PracticeTable.DMScore, "
     Sqlstr = Sqlstr & "  PracticeTable.CVDDisplay, PracticeTable.CVDScore, "
      Sqlstr = Sqlstr & "  PracticeTable.Hypertension_Care, PracticeTable.Hypertension_Care_Score, "
  'old code but ' out flagcurrent, isdeleted, OP0000, and order by
     Sqlstr = Sqlstr & "  SortOverall "
     Sqlstr = Sqlstr & "  FROM PracticeTable "
     Sqlstr = Sqlstr & "    Where (FamilyMedicine=1 or InternalMedicine=1)"
 
 
 Set rs = New ADODB.Recordset
rs.Open Sqlstr, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
     Do While Not rs.EOF
          Num_Measures = 0
 
          OSS = AssignRatingValue(Nz(rs!OSSDisplay, ""))
          If OSS > 0 Then Num_Measures = Num_Measures + 1
 
 
          Diab = AssignRatingValue(Nz(rs!DMDisplay, ""))
          If Diab > 0 Then Num_Measures = Num_Measures + 1
 
          CVD = AssignRatingValue(Nz(rs!CVDDisplay, ""))
          If CVD > 0 Then Num_Measures = Num_Measures + 1
 
          'added 01 april 2013 for HT
 
          HT = AssignRatingValue(Nz(rs!Hypertension_Care, ""))
          If HT > 0 Then Num_Measures = Num_Measures + 1
 
          '01 april 2013 added HT to formula and message box
 
          old_sort = Nz(rs!SortOverall, 0)
          If Num_Measures > 0 Then new_sort = Round((OSS + Diab + CVD + HT) / Num_Measures, 2)
 
 
 
 
          If old_sort <> new_sort Then
             Update_Response = MsgBox(rs!PracticeName & " (" & rs!OPNumber & ")" & vbCrLf _
                                      & vbCrLf _
                                      & "OSS  = " & rs!OSSDisplay & "(" & rs!OSSScore & ")" & vbCrLf _
                                      & "Diab = " & rs!DMDisplay & "(" & rs!DMScore & ")" & vbCrLf _
                                      & "CVD  = " & rs!CVDDisplay & "(" & rs!CVDScore & ")" & vbCrLf _
                                      & "HT  = " & rs!Hypertension_Care & "(" & rs!Hypertension_Care_Score & ")" & vbCrLf _
                                      & vbCrLf _
                                      & "Current SortOverall = " & old_sort & vbCrLf _
                                      & "Calculated SortOverall: (" & OSS & " + " & Diab & " + " & CVD & " + " & HT & ") / " & Num_Measures & " = " & new_sort & vbCrLf _
                                      & vbCrLf _
                                      & "Would you like to update this practice's SortOverall?" _
                            , vbYesNo _
                            , "Update SortOverall?")
 
             If Update_Response = vbYes Then
 
 
                 DoCmd.RunSQL tmpSQL, False
 
                 tmpSQL = "Update PracticeTable " _
                       & "  Set     PracticeTable.SortOverall=" & new_sort _
                       & " where PracticeTable.OPNumber=" & rs!OPNumber 
 
                cnn.BeginTrans
                   With cmd
                      .CommandType = adCmdText
                      .ActiveConnection = cnn
                      .CommandText = tmpSQL
                      .Execute
                   End With
                cnn.CommitTrans
                tmpSQL = ""
             End If
 
          End If
 
          rs.MoveNext
     Loop
 
 
Exit_cmdUpdate_SortOverall:
 
     Set rs = Nothing
     Screen.MousePointer = 1
 
     Exit Sub
 
Err_cmdUpdate_SortOverall:
    Screen.MousePointer = 1
    MsgBox "Error while updating SortOverall:" & Err.Description & Err.Number
    DoCmd.SetWarnings True
 
    Resume Exit_cmdUpdate_SortOverall
End Sub
 
 
 
 

[r035198x]

Write out the SQL that you are using to run the update and check that it is correct. Run it durectly against the database to see if it works there. Maybe it's not matching the values in your where clause.

[barbarao]

When I enter the SQL code and specify which OPNumber to update, it works fine. the problem seems to be

" where PracticeTable.OPNumber=" & rs!OPNumber 

. Any other suggestions? Much appreciated.

[barbarao]

Specifically it is saying the value in rs!OPNumber is not a valid column name. The column name is OPNumber and the rs!OPNumber is a value in the column for which I want the recordset to be updated with Line 85.

[barbarao]

Figured it out but new problem. Changed line 86 to be

& " where PracticeTable.OPNumber= '" & rs!OPNumber & "';"

but line 73 gives me unconsistent results if adding 0 + 0 +0 +0. Any thoughts anyone?

[r035198x]

Are you using the correct types? Integer vs String

[barbarao]

Yes, all are Integer. Figured it out. Added a new line.

 If Num_Measures = 0 Then new_sort = 0

those with zero number of measures now working. Thanks.