Problem could be rs.nomatch

[NeverTooLate]

I've written code to update pricing. If some but not all of [UnitPriceNew] fields = 0 then code works. Problem is, if all of the [UnitPriceNew] fields = 0 then the first msgbox is ignored and pricing is updated, which is what I want to avoid at all costs. Please help!

Private Sub cmdUpdatePrices_Click()
   
  'PURPOSE: In TblParts, update Unit Prices to new prices [UnitPriceNew], delete any Price Rises
  'and then delete the New Unit prices. 
   
      Dim db As dao.Database
      Dim RS As Recordset
      Dim strSql As String
      Dim intAnswer As Integer
           
      strSql = "SELECT * From TblParts"
   
      Set db = CurrentDb()
      Set RS = db.OpenRecordset(strSql, dbOpenDynaset)
      
  'Check if any of the parts don't have a new price
   
      RS.FindFirst RS!UnitPriceNew = 0
      
  'If one or more parts don't have a new price, then ask if user would like to exit this routine
  'and open TblParts ready for inputting missing prices.
   
  If not RS.NoMatch Then
      intAnswer = MsgBox("One or more parts are missing New Unit Prices. " _
      & "Do you want to exit this routine so you can fix the prices? " _
      & vbCrLf & vbCrLf & "(No means that the prices will continue to be updated which may result in $0 amounts.)", vbCritical + vbYesNo, "Missing Prices")
   
  Select Case intAnswer
      Case vbYes
          GoTo Exit_cmdUpdatePrices_Click
      Case vbNo 'if No is chosen from the message box, continue to update new prices
  End Select
  End If
   
  'If no records have UnitPriceNew=0 (or if 'no' was chosen from the msgbox) then continue with this code
   
  RS.MoveFirst
  Do Until RS.EOF()
      RS.Edit
      RS![UnitPrice] = RS![UnitPriceNew]
      RS![pricerise] = 0
      RS!UnitPriceNew = 0
      RS.Update
      RS.MoveNext
  Loop
   
      MsgBox "Updates to prices are complete"
   
  Exit_cmdUpdatePrices_Click:
      DoCmd.OpenTable ("tblParts")
      Exit Sub
   
  End Sub

 

[spikepl]

please paste code in code brackets. Choose Advanced, select code, click on "#"

 

[vbaInet]

please paste code in code brackets. Choose Advanced, select code, click on "#"

-->

http://www.access-programmers.co.uk/forums/showthread.php?p=1009015#post1009015

I don't see why you are using a recordset anyway. Why not count using a DCount() function and respond accordingly. If an update is needed run/execute an UPDATE query using DoCmd.RunSQL or CurrentDb.Execute.

 

[NeverTooLate]

Top tip spikepl!! Not only did your suggestion work but the code is so much more simple! This is what I ended up with:

Dim a1 As Integer
Dim intanswer As Integer
Dim sql As String
Dim db As DAO.Database

Set db = CurrentDb

a1 = DCount("UnitPriceNew", "tblparts", "UnitPriceNew = 0")

If a1 > 0 Then

intanswer = MsgBox("One or more parts are missing New Unit Prices. " _
    & "Do you want to exit this routine so you can fix the prices? " _
    & vbCrLf & vbCrLf & "(No means that the prices will continue to be updated which may result in $0 amounts.)", vbCritical + vbYesNo, "Missing Prices")
Select Case intanswer
    Case vbYes
        GoTo Exit_cmdUpdatePrices_Click
    Case vbNo 'if No is chosen from the message box, continue to update new prices
End Select
End If

sql = "UPDATE TblParts SET UnitPrice = [UnitPriceNew], PriceRise = 0, UnitPriceNew = 0;"
db.Execute sql, dbFailOnError

MsgBox "done"

Exit_cmdUpdatePrices_Click:
    DoCmd.OpenTable ("tblParts")
    Exit Sub

 

[vbaInet]

Unecessary use of variables. Revised code:

Dim intanswer As Integer
Dim db As DAO.Database

Set db = CurrentDb

If DCount("UnitPriceNew", "tblparts", "UnitPriceNew = 0") <> 0 Then

    intanswer = MsgBox("One or more parts are missing New Unit Prices. " _
                     & "Do you want to exit this routine so you can fix the prices? " _
                     & vbCrLf & vbCrLf & _
                     "(No means that the prices will continue to be updated which may result in $0 amounts.)", _
                       vbCritical + vbYesNo, "Missing Prices")

    If intanswer = vbYes Then
        GoTo Exit_cmdUpdatePrices_Click
    End If

    db.Execute "UPDATE TblParts " & _
               "SET UnitPrice = [UnitPriceNew], PriceRise = 0, UnitPriceNew = 0;", dbFailOnError

End If

MsgBox "done"

Exit_cmdUpdatePrices_Click:
    DoCmd.OpenTable ("tblParts")
    Exit Sub

spikepl can get this one too