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.