Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

SORT & UPDATE RECORDSET!! STUCK! STUCK!!!!!

Status
Not open for further replies.

LBERNARDE

Programmer
Mar 14, 2001
21
US
I have a table with shooters in it and there total scores.
There are 3 different classes (Master, Expert and Sharpshooter) and
there are 3 different postiions (Standing, Kneeling and Prone).
The number of awards handed out depends on the number of
competitors.
What I’ve done is create a recordset with only one class, I then count
The number of competitors to determine number of places to be
awarded.
I want to sort in Descending order, start @ record number 1 and assign
first place, advance to next record and assign #2, etc. I want this
ultimately to be updated in the actual table. It IS updating the actual
table, but with no rhyme or reason. I thought adding the bookmark
would
make it know which record to place the award in, but it is not working.
I’m not really sure my sorts are working. ANY advice is appreciated.
I’m kind a new @ VBA. I will post all of the current code later today,
but this is a basic explanation of what I’m trying to do. Hope it makes
sense.
Thanks Lisa

******************
*CODE*
******************
Option Compare Database
Sub SQLX()
Dim dbsOshkosh As Database
Dim qdfTemp As QueryDef
Dim RSTCLASS As Recordset
Dim strsqloutput As String
Dim VARBOOKMARK As String
Dim VARAUTONUMBER As Variant
Set dbsOshkosh = CurrentDb
Set qdfTemp = dbsOshkosh.CreateQueryDef("")
Set RSTCLASS = CurrentDb().OpenRecordset("tblclass",
dbOpenTable)
strClass = RSTCLASS!CLASS
RSTCLASS.MoveFirst
' Open Recordset using temporary QueryDef object
'SQLOutput "SELECT
Count(tblSMALBOREPOSITIONAWARDS.NUMBER) AS CountOfNUMBER,"
& _
'"FROM tblSMALBOREPOSITIONAWARDS" & _
'"WHERE (((tblSMALBOREPOSITIONAWARDS.CLASS)= " & strClass &
" ))", qdfTemp

'SQLOutput "SELECT * FROM tblsmalborepositionawards " & _
' "WHERE (((tblsmalborepositionawards!class = " & strClass & "))"
& _
' "ORDER BY CLASS", qdfTemp

'SQLOutput "SELECT * FROM tblsmalborepositionawards " & _
' "WHERE tblsmalborepositionawards!class = rstclass!class " & _
' "ORDER BY CLASS", qdfTemp

SQLOutput "SELECT * FROM tblsmalborepositionawards " & _
"WHERE tblsmalborepositionawards!class = 'MASTER' " & _
"ORDER BY CLASS", qdfTemp

SQLOutput "SELECT * ," & _
"FROM tblSMALBOREPOSITIONAWARDS" & _
"WHERE (((tblSMALBOREPOSITIONAWARDS.CLASS)= " & strClass &
" ))", qdfTemp
dbsOshkosh.Close
End Sub

Function SQLOutput(strSQL As String, qdfTemp As QueryDef)
Dim rstclass2 As Recordset
Dim strreccount As String
' Set SQL property of temporary QueryDef object and open
' a Recordset.
qdfTemp.SQL = strSQL
Set rstclass2 = qdfTemp.OpenRecordset
GoSub proneawards
'End Function

'Sub ProneAwards(rstclass2 As Recordset)

proneawards:
With rstclass2
.MoveLast
strreccount = rstclass2.recordcount
.MoveFirst
End With

If strreccount <= 5 Then
mplace = 1
If strreccount > 5 And strreccount <= 10 Then
mplace = 2
If strreccount > 10 Then
mplace = 3
End If
End If
End If

mplacecounter = 0

STRSORTON = &quot;RSTCLASS2!PRONEMMA&quot;
'With rstClass2
rstclass2.Sort = STRSORTON
rstclass2.MoveFirst
VARBOOKMARK = rstclass2.Bookmark
VARAUTONUMBER = rstclass2!AUTONUMBER

'VARBOOKMARK = rstclass2.AbsolutePosition + 1

Do
Do While mplacecounter <= mplace
mplacecounter = mplacecounter + 1
If mplacecounter = 1 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!proneaward = &quot;1st Prone&quot;
rstclass2.Update
rstclass2.MoveNext
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1
Else
If mplacecounter = 2 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!proneaward = &quot;2nd Prone&quot;
rstclass2.Update
rstclass2.MoveNext
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1
Else
If mplacecounter = 3 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!proneaward = &quot;3rd Prone&quot;
rstclass2.Update
rstclass2.MoveNext
VARBOOKMARK = RSTLCASS2.Bookmark
mplacecounter = mplacecounter + 1
End If
End If
End If
Loop
Loop Until mplacecounter >= mplace


GoSub StandAwards
'End Sub
Return

'Sub StandAwards()
StandAwards:
With rstclass2
.MoveLast
strreccount = rstclass2.recordcount
.MoveFirst

End With

If strreccount <= 5 Then
mplace = 1
If strreccount > 5 And strreccount <= 10 Then
mplace = 2

If strreccount > 10 Then
mplace = 3
End If
End If
End If

mplacecounter = 0
STRSORTON2 = &quot;STANDMMA&quot;
'With rstClass2
rstclass2.Sort = STRSORTON2
rstclass2.MoveLast
'VARBOOKMARK = rstclass2.Bookmark
VARAUTONUMBER = rstclass2!AUTONUMBER

Do
Do While mplacecounter <= mplace
mplacecounter = mplacecounter + 1
If mplacecounter = 1 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!standaward = &quot;1st Standing&quot;
rstclass2.Update
rstclass2.MovePrevious
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1

Else
If mplacecounter = 2 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!standaward = &quot;2nd Standing&quot;
rstclass2.Update
rstclass2.MovePrevious
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1
Else
If mplacecounter = 3 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!standaward = &quot;3rd Standing&quot;
rstclass2.Update
rstclass2.MovePrevious
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1
End If
End If
End If
Loop
Loop Until mplacecounter >= mplace
GoSub KneelAwards


'End Sub
'Sub KneelAwards()
KneelAwards:
With rstclass2
.MoveLast
strreccount = rstclass2.recordcount
.MoveFirst
End With

If strreccount <= 5 Then
mplace = 1
If strreccount > 5 And strreccount <= 10 Then
mplace = 2
If strreccount > 10 Then
mplace = 3
End If
End If
End If

mplacecounter = 0
STRSORTON3 = &quot;RSTCLASS2!KNEELMMA&quot;
'With rstClass2
rstclass2.Sort = STRSORTON3
rstclass2.MoveLast
VARBOOKMARK = rstclass2.Bookmark
VARAUTONUMBER = rstclass2!AUTONUMBER
Do
Do While mplacecounter <= mplace
mplacecounter = mplacecounter + 1

If mplacecounter = 1 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!kneelaward = &quot;1st Kneeling&quot;
rstclass2.Update
rstclass2.MovePrevious
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1
Else
If mplacecounter = 2 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!kneelaward = &quot;2nd Kneeling&quot;
rstclass2.Update
rstclass2.MovePrevious
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1
Else
If mplacecounter = 3 Then
rstclass2.Bookmark = VARBOOKMARK
rstclass2.Edit
rstclass2!kneelaward = &quot;3rd Kneeling&quot;
rstclass2.Update
rstclass2.MovePrevious
VARBOOKMARK = rstclass2.Bookmark
mplacecounter = mplacecounter + 1
End If
End If
End If
Loop
Loop Until mplacecounter >= mplace
End Function
'End Sub
 
I used to be on the rifle team many years ago when I was young.

Unless I am missing something, I would take this general approach.

(1) Create a recordset of all shooters where score is true and ORDER BY class and score. You can use the query builder to create and test SQL and then copy the sql into your VBA program.

(2)Then set up a recordset loop something like

Sub Awards()

Dim dbs As Database
Dim rs As Recordset
Dim strSQL As String

Set dbs = CurrentDb()

strSQL=&quot;SELECT..FROM tblShooters WHERE ..ORDER BY .... &quot;

Set rs = dbs.OpenRecordset(strSQL)

Do Until rs.EOF
If rs!Class1 = ....
rs.edit
rs!Award_Place = And ...
rs.update
End if

If rs!Class2 = ....
rs.edit
rs!Award_Place = And ...
rs.update
End if

etc.......

rs.MoveNext
Loop

rs.Close
Set rs = Nothing
dbs.Close
Set dbs = Nothing
End Sub



 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top