Using recordset to update

adh123 · Aug 12, 2016

The below code does not seem to produce any errors but is not updating any values in each recordset - is there something blatantly obvious which I have forgotten to do (I know its all not justified, have removed most of the code as is not relevant to the post)?

FYI me.cmb_date (column 0) is an integer

Code:

Private Sub btn_submit_Click()

On Error GoTo err_btn_submit_click

Dim rstRed As DAO.Recordset
Dim rstColours As DAO.Recordset

Dim vbaPaid As String
Dim vbaSubmitScore As String
Dim RedScore As Integer
Dim ColourScore As Integer
Dim strRedResult As String
Dim strColourResult As String


Set rstRed = CurrentDb.OpenRecordset("SELECT * FROM qry_match_result_red WHERE m_ref = " & Me.cmb_date)
Set rstColours = CurrentDb.OpenRecordset("SELECT * FROM qry_match_result_colours WHERE m_ref = " & Me.cmb_date)

        RedScore = Me.txt_red.Value
        ColourScore = Me.txt_colour.Value

            strRedResult = "W"
            strColourResult = "L"


            Do While Not rstRed.EOF
                rstRed.Edit
                rstRed![t_result] = strRedResult
                rstRed![t_for] = RedScore
                rstRed![t_against] = ColourScore
                rstRed.Update
                
                rstRed.MoveNext
            Loop
            
            Do While Not rstColours.EOF
                rstColours.Edit
                rstColours![t_result] = strColoursResult
                rstColours![t_for] = ColourScore
                rstColours![t_against] = RedScore
                rstColours.Update
                
                rstColours.MoveNext
            Loop
            
 
rstRed.Close
rstColours.Close

Set rstRed = Nothing
Set rstColours = Nothing

exit_btn_submit_click:
    Exit Sub

err_btn_submit_click:
    MsgBox Err.Description
    Resume exit_btn_submit_click


End Sub

pbaldy · Aug 12, 2016

An update query would be more efficient than a loop. Have you set a breakpoint or used another method to see if any records are returned by the recordsets? If that's a date field:

Set rstRed = CurrentDb.OpenRecordset("SELECT * FROM qry_match_result_red WHERE m_ref = #" & Me.cmb_date & "#")

CJ_London · Aug 12, 2016

looks like you are trying to update a query rather than a table

pbaldy · Aug 12, 2016

CJ_London said:
looks like you are trying to update a query rather than a table

Can't say that I've ever tried, but I assumed that you could do that, presuming the query was not read-only. Not so?

CJ_London · Aug 12, 2016

well I've not tried either but the query may not be updateable which was really my point - I just hit submit before putting that bit in!

MS says

'You can modify existing records in a table-type or dynaset-type Recordset object by using the Edit and Update methods.'

Frothingslosh · Aug 12, 2016

pbaldy said:
Can't say that I've ever tried, but I assumed that you could do that, presuming the query was not read-only. Not so?

You can as long as the resulting recordset is updatable - ie, be careful with your joins, no grouping, etc. I'd only recommend that method with 1-record recordsets, though, unless there's no other option!

pbaldy · Aug 12, 2016

I would assume you'd get an error if the query was read-only. My guess is no records are being returned.

Frothingslosh · Aug 12, 2016

Yeah, looking at his code, if both recordsets are empty, it's going to just skip right over the loops.

Time for the dreaded If .EOF!

adh123 · Aug 15, 2016

pbaldy said:
An update query would be more efficient than a loop. Have you set a breakpoint or used another method to see if any records are returned by the recordsets? If that's a date field:

Set rstRed = CurrentDb.OpenRecordset("SELECT * FROM qry_match_result_red WHERE m_ref = #" & Me.cmb_date & "#")

Thanks for the suggestion, but the primary field (if thats the correct term) for me.cmb_date (column 0) is a 4 digit number which is what I am trying to select from. (column 1 contains the date but would prefer not to search on this).

Only using a query as I thought it would be easier to due to not managing to get my head around joining multiple tables together in the recordset, attached the database if it helps with any suggestions.
Form is frm_match_day which has the function.

Having inserted the err.description into the code it does say it is read only?

EDIT: might need to select match date for "08/08/16" as this one has dummy records against it.

pbaldy · Aug 15, 2016

Yes, both queries are read-only. You can open them directly and try to edit something and you'll get an error.

http://allenbrowne.com/ser-61.html

adh123 · Aug 15, 2016

pbaldy said:
Yes, both queries are read-only. You can open them directly and try to edit something and you'll get an error.

http://allenbrowne.com/ser-61.html

Changing the rstRed to

Code:

Set rstRed = CurrentDb.OpenRecordset("SELECT * FROM tbl_team WHERE m_ref = " & Me.cmb_date & " and t_team = " & 1)

seems to help - not quite sure why i was trying to include other tables in the query!

Still getting an error but I think that is due to the rest of the vba being incomplete so hopefully with all your suggestions this is fixed. Will take a look this evening and see if I can get it all working properly!

pbaldy · Aug 15, 2016

No problem, post back if you're still stuck.

adh123 · Aug 19, 2016

Yup, all works.

Full vba code if anyone else needs it now it works, I am sure there is a neater way of doing this!

Code:

Private Sub btn_submit_Click()

On Error GoTo err_btn_submit_click

Dim rstRed As DAO.Recordset
Dim rstColours As DAO.Recordset

Dim vbaPaid As String
Dim vbaSubmitScore As String
Dim RedScore As Integer
Dim ColourScore As Integer
Dim MatchLock As String
Dim strRedResult As String
Dim strColourResult As String

If Me.txt_red.Value & "" = "" Then
    Me.txt_red.SetFocus
    MsgBox "Enter red team score"
    Exit Sub
    
    ElseIf Me.txt_colour.Value & "" = "" Then
    Me.txt_colour.SetFocus
    MsgBox "Enter colour score"
    Exit Sub
    
    ElseIf Me.txt_pitch_cost.Value & "" = "" Then
    Me.txt_pitch_cost.SetFocus
    MsgBox "Enter pitch cost"
    Exit Sub
    
    ElseIf Me.txt_player_fee.Value & "" = "" Then
    Me.txt_player_fee.SetFocus
    MsgBox "Enter player fee"
    Exit Sub
End If

vbaPaid = MsgBox("Have you completed all players pay status?", vbYesNo, "Paid?")

If vbaPaid = vbYes Then

    vbaSubmitScore = MsgBox("Final score :" & Chr(13) & Chr(13) & "Reds " & Me.txt_red.Value & " - " & Me.txt_colour.Value & " Colours?", vbYesNo, "Submit score?")
    
    If vbaSubmitScore = vbYes Then
        MsgBox "Saving"
        
        RedScore = Me.txt_red.Value
        ColourScore = Me.txt_colour.Value
        
        MatchLock = "UPDATE tbl_match SET m_lock = " & -1 & " WHERE m_ref = " & Me.cmb_date.Column(1)
        DoCmd.RunSQL MatchLock
        
        If Me.txt_red.Value > Me.txt_colour.Value Then
            MsgBox "Red team wins!"
            strRedResult = "W"
            strColoursResult = "L"
          
            'insert result into tbl_team for each p_ref (same m_ref)
            
            Set rstRed = CurrentDb.OpenRecordset("SELECT * FROM tbl_team WHERE m_ref = " & Me.cmb_date & " and t_team = " & 1)
            Set rstColours = CurrentDb.OpenRecordset("SELECT * FROM tbl_team WHERE m_ref = " & Me.cmb_date & " and t_team = " & 2)

            Do While Not rstRed.EOF
                rstRed.Edit
                rstRed![t_result] = strRedResult
                rstRed![t_for] = RedScore
                rstRed![t_against] = ColourScore
                rstRed.Update
                
                rstRed.MoveNext
            Loop
            
            Do While Not rstColours.EOF
                rstColours.Edit
                rstColours![t_result] = strColoursResult
                rstColours![t_for] = ColourScore
                rstColours![t_against] = RedScore
                rstColours.Update
                
                rstColours.MoveNext
            Loop
            
            Exit Sub
        
            ElseIf Me.txt_red.Value < Me.txt_colour.Value Then
                MsgBox "Colour team wins!"
            
                strRedResult = "L"
                strColoursResult = "W"
          
                'insert result into tbl_team for each p_ref (same m_ref)
            
                Set rstRed = CurrentDb.OpenRecordset("SELECT * FROM tbl_team WHERE m_ref = " & Me.cmb_date & " and t_team = " & 1)
                Set rstColours = CurrentDb.OpenRecordset("SELECT * FROM tbl_team WHERE m_ref = " & Me.cmb_date & " and t_team = " & 2)

                Do While Not rstRed.EOF
                    rstRed.Edit
                    rstRed![t_result] = strRedResult
                    rstRed![t_for] = RedScore
                    rstRed![t_against] = ColourScore
                    rstRed.Update
                
                    rstRed.MoveNext
                Loop
            
                Do While Not rstColours.EOF
                    rstColours.Edit
                    rstColours![t_result] = strColoursResult
                    rstColours![t_for] = ColourScore
                    rstColours![t_against] = RedScore
                    rstColours.Update
                    
                    rstColours.MoveNext
                Loop
                
                Exit Sub
        
            ElseIf Me.txt_red.Value = Me.txt_colour.Value Then
                MsgBox "Draw game"
                
                strRedResult = "D"
                strColoursResult = "D"
              
                'insert result into tbl_team for each p_ref (same m_ref)
                
                Set rstRed = CurrentDb.OpenRecordset("SELECT * FROM tbl_team WHERE m_ref = " & Me.cmb_date & " and t_team = " & 1)
                Set rstColours = CurrentDb.OpenRecordset("SELECT * FROM tbl_team WHERE m_ref = " & Me.cmb_date & " and t_team = " & 2)
    
                Do While Not rstRed.EOF
                    rstRed.Edit
                    rstRed![t_result] = strRedResult
                    rstRed![t_for] = RedScore
                    rstRed![t_against] = ColourScore
                    rstRed.Update
                    
                    rstRed.MoveNext
                Loop
                
                Do While Not rstColours.EOF
                    rstColours.Edit
                    rstColours![t_result] = strColoursResult
                    rstColours![t_for] = ColourScore
                    rstColours![t_against] = RedScore
                    rstColours.Update
                    
                    rstColours.MoveNext
                Loop
                
                Exit Sub
        
        End If
        
    Else
    Exit Sub
    End If
        
Else
MsgBox "Complete paid status for each player, then try again"
Exit Sub
End If

rstRed.Close
rstColours.Close

Set rstRed = Nothing
Set rstColours = Nothing

exit_btn_submit_click:
    Exit Sub

err_btn_submit_click:
    MsgBox Err.Description
    Resume exit_btn_submit_click


End Sub

pbaldy · Aug 19, 2016

Glad you got it working.

adh123 said:
I am sure there is a neater way of doing this!

There is, mentioned in post 2.

Using recordset to update

adh123

Registered User.

pbaldy

Wino Moderator

CJ_London

Super Moderator

pbaldy

Wino Moderator

CJ_London

Super Moderator

Frothingslosh

Premier Pale Stale Ale

pbaldy

Wino Moderator

Frothingslosh

Premier Pale Stale Ale

adh123

Registered User.

Attachments

pbaldy

Wino Moderator

adh123

Registered User.

pbaldy

Wino Moderator

adh123

Registered User.

pbaldy

Wino Moderator

Users who are viewing this thread