Hi all
I have the code below in the lost focus event. It does work, but it
does not update the form that is onscreen.
What do I need to add?
Any help is appreciated.
This is my first VBA try, my other programming has been (autocad) LISP,
so I know it is not good basic code, but it works
and that is good enough for now. I need this done by the 28'th.
Robert
Private Sub Ctl400_Meter_Run_LostFocus()
Dim Current_Scout_Rank As String
Dim Current_Event As String
Current_Scout_Rank = Forms("scout-event").[Scout Rank].Value
Current_Event = Screen.ActiveControl.Name
Dim dbs As DAO.Database
Dim rsCurr As DAO.Recordset
Dim strSQL As String
Set dbs = CurrentDb
strSQL = "Select [Scout Name],[Scout Rank],[" & Current_Event & "] From
[scout-event] Where [Scout Rank] = " & Chr(34) & Current_Scout_Rank &
Chr(34) & " And [" & Current_Event & "] Is Null;"
Set rsCurr = dbs.OpenRecordset(strSQL, dbOpenDynaset)
If rsCurr.BOF = False And rsCurr.EOF = False Then 'IF A
'** there is at least one record in the recordset
rsCurr.MoveFirst
Do While rsCurr.EOF = False 'WHILE A
MsgBox "No scoring provided yet becuse not all of the event results
have been entered for this rank."
'goto the end of the recordset to the end
Do While rsCurr.EOF = False 'WHILE B
rsCurr.MoveNext
Loop 'WHILE B
Loop 'WHILE A
End If 'IF A
strSQL = "Select [Scout Name],[Scout Rank],[" & Current_Event & "],[" &
Current_Event & " Points" & "] From [scout-event] Where [Scout Rank] = "
& Chr(34) & Current_Scout_Rank & Chr(34) & " And [" & Current_Event & "]
Is NOT Null ORDER BY [" & Current_Event & "];"
Set rsCurr = dbs.OpenRecordset(strSQL, dbOpenDynaset)
If rsCurr.BOF = False And rsCurr.EOF = False Then 'IF B
'** there is at least one record in the recordset
rsCurr.MoveFirst 'goto first record in recordset
Do While rsCurr.EOF = False 'WHILE C
If rsCurr.EOF = False Then 'IF C
'Dim scoutname As String Dim scoutrank As String Dim
scouteventresult As String Dim scouteventpoints As String
'Let scoutname = rscurr(0) Let scoutrank = rscurr(1) Let
scouteventresult = rscurr(2) Let scouteventpoints = rscurr(3)
'MsgBox scoutname MsgBox scoutrank MsgBox scouteventresult MsgBox
scouteventpoints
Dim Event_score As Integer
Event_score = 100
Dim Event_result As String
Event_result = rsCurr(2)
Dim Next_event_result As String
'put the score into first place
With rsCurr
.Edit
rsCurr(3) = Event_score
.Update
.Bookmark = .LastModified
End With
MsgBox "First Place"
MsgBox Event_score
'finished scoring first place
Do While Event_score >= 60 And rsCurr.EOF = False 'WHILE D there
is scoring above 5 place to do
Dim Tie_count As Integer
Tie_count = 1
rsCurr.MoveNext
If rsCurr.EOF = False Then 'IF D
Next_event_result = rsCurr(2)
End If 'IF D
Do While Event_result = Next_event_result And rsCurr.EOF = False
'WHILE E check for a tie
'enter the same score for the other person(s) in a tie
With rsCurr
.Edit
rsCurr(3) = Event_score
.Update
.Bookmark = .LastModified
End With
MsgBox "A TIE"
MsgBox Event_score
Tie_count = Tie_count + 1
'finished scoring the tie
If rsCurr.EOF = False Then 'IF E
rsCurr.MoveNext
End If 'IF E
Next_event_result = rsCurr(2)
Loop 'WHILE E check for a tie
Event_score = Event_score - (10 * Tie_count)
Tie_count = 1
If rsCurr.EOF = False Then 'IF F
Event_result = rsCurr(2)
With rsCurr
.Edit
MsgBox "NEXT PLACE"
MsgBox Event_score
rsCurr(3) = Event_score
.Update
.Bookmark = .LastModified
End With
End If 'IF F closed
Loop ' WHILE there is scoring above 5 place to do
' set the rest of the scores to 50
Event_score = 50
With rsCurr
.Edit
MsgBox "Finishing"
MsgBox Event_score
rsCurr(3) = Event_score
.Update
.Bookmark = .LastModified
End With
If rsCurr.EOF = False Then
rsCurr.MoveNext
End If
' set the rest of the scores to 50
End If 'IF C
Loop 'WHILE C
End If 'IF B
rsCurr.Close
Set rsCurr = Nothing
dbs.Close
Set dbs = Nothing
End Sub
|
Similar Threads
