Results 1 to 10 of 10
Thread: VBA for use in Access 2000

091103, 06:10 #1Registered User
 Join Date
 Sep 2003
 Location
 London, England
 Posts
 52
Unanswered: VBA for use in Access 2000
Further Mathematics A Level Cashin choices.
My Access 2000 database keeps module results (marks out of 100) for various modules in which my students have been examined. Each student is identified by a unique number. All Further Maths students study the same 12 maths modules which may be cashed in to get their final grades according to 9 different legitimate combinations.
The modules are called P1, P2, P3, P4, P5, P6, D1, M1, M2, M3, S1, S2. Each module mark is out of 100.
The allowed combinations for the single A Level are as follows:
1.[P1, P2, P3, D1, M1, M2]
2.[P1, P2, P3, D1, S1, M2]
3.[P1, P2, P3, M1, S1, M2]
4.[P1, P2, P3, D1, M1, M3]
5.[P1, P2, P3, D1, S1, M3]
6.[P1, P2, P3, M1, S1, M3]
7.[P1, P2, P3, D1, M1, S2]
8.[P1, P2, P3, D1, S1, S2]
9.[P1, P2, P3, M1, S1, S2]
In each case the 6 remaining modules make up the further maths marks.
The sum of the marks for each module that make up these combinations (call this sum sigma) leads to the grade for that combination. Let us call the single maths sums Ai and the further maths sums Fi. Thus each student has 9 ordered pairs (A1, F1) to (A9, F9) that represent the possible pairs of mark totals for each combination.
The mark sums are then converted to grades according to the following rules:
Sigma > 479 gives grade = A
419 < Sigma < 480 gives grade = B
359 < Sigma < 420 gives grade = C
299 < Sigma < 360 gives grade = D
239 < Sigma < 300 gives grade = E
Sigma < 240 gives grade = F
The grades then relate to UCAS points (for university entrance) so that A=12 ; B=10; C=8; D=6; E=4; F=2.
Let us call the single maths UCAS points Bi and the further maths points Gi. Thus each student has 9 ordered pairs (B1, G1) to (B9, G9) that represent the possible pairs of UCAS points for each cashin combination.
Now we must select for each student those pairs that generate the maximum UCAS points total, call this total max(Bi + Gi), which may well be the same for several values of i.
From these maximal pairs we must choose the one(s) that gives us the maximum value of Ai.
We will then know the best legitimate way to cashin the modules of each student and we will just have to note the combination (Combi) and resulting grades (as Result1 and Result2) for each of the students accordingly.
I understand the problem and I could produce macros to do each part (over 100 SQL statements!) but there must be a quicker way if only I knew VB and could use it in Access.
Please can anyone show me how to solve this problem simply?

091103, 08:51 #2Cavalier King Charles
 Join Date
 Dec 2002
 Location
 Préverenges, Switzerland
 Posts
 3,740
an interesting problem elegantly stated.
at first sight it looks realtively simple to crack this in code, but there is one rule that is not clear to me: how do you "balance" the optimization between single & further maths.
i.e. which is optimum:
Single=12 & Further=8
Single=8 & Further=12
Single=10 & Further=10
izy

091103, 09:17 #3Registered User
 Join Date
 Sep 2003
 Location
 London, England
 Posts
 52
Originally posted by izyrider
an interesting problem elegantly stated.
at first sight it looks realtively simple to crack this in code, but there is one rule that is not clear to me: how do you "balance" the optimization between single & further maths.
i.e. which is optimum:
Single=12 & Further=8
Single=8 & Further=12
Single=10 & Further=10
izy
From these maximal pairs we must choose the one(s) that gives us the maximum value of Ai.
Hence
Single=12 & Further=8 would be best in your example.
John

091103, 13:43 #4Cavalier King Charles
 Join Date
 Dec 2002
 Location
 Préverenges, Switzerland
 Posts
 3,740
those reading skills deserted me again!
here's a first pass with lots of assumptions
you have a table to grab some output with fields:
studentID, and integers
SingleMaths
FurtherMaths
Scheme
i would be tempted to wipe the output table at the beginning of the run, but i did not include a wipe in the code
since you were about to make 100 SQL queries, i guess you wont be too upset to make one query to gather the data... maybe the * scheme i have below will do it, otherwise you need to get theField as P1 etc etc
typing in the additions for sinMark() & furMark() is really boring. this is left as an exercise for the student see the bit cordoned off with '#########
i don't know if my topSinPlusFurUcas construction has merit. maybe simply checking furUcas against a topFurUcas is better. probably it makes no difference at all
last thought: i think the syntax is ok here, but i don't have your data (or the patience to type in all the additions) so i can't run the code to check it.
have fun. izy
Code:Private Sub optimiseResults() 'assuming integer fields are P1, P2, P3, P4, P5, P6, D1, M1, M2, M3, S1, S2 Dim sinMark(1 To 9) As Integer 'SingleMaths sum(mark) Dim furMark(1 To 9) As Integer 'FurtherMaths sum(mark) Dim sinGrad(1 To 9) As String * 1 'SingleMaths grade Dim furGrad(1 To 9) As String * 1 'FurtherMaths grade Dim sinUcas(1 To 9) As Integer 'SingleMaths UCAS Dim furUcas(1 To 9) As Integer 'FurtherMaths UCAS Dim topSinUcas As Integer Dim topSinPlusFurUcas As Integer Dim optimum As Integer Dim loupe As Integer 'a loop counter 'using DAO syntax: either convert to ADO or include reference to 'the DAO library: altF11 / Tools / References and scroll down 'to Microsoft DAO 3.6 library and "tick" it Dim dabs As DAO.database 'ERROR IN THE ORIGINAL POST: THIS IS GARBAGE: 'Dim reci As DAO.database 'input recordset 'Dim reco As DAO.database 'output database 'REPLACE WITH: dim reci as dao.recordset dim reco as dao.recordset Dim strSQL As String 'construct SQL to pull StudentID, P1, P2, P3 etc 'if * wont do it, the details are left as an exercise for the reader strSQL = "SELECT * FROM theTable" Set dabs = CurrentDb Set reci = dabs.OpenRecordset(strSQL) Set reco = dabs.OpenRecordset("outputTable") With reci .MoveFirst 'this is no necessary, just my paranoia! 'loop through input record for each student Do While Not .EOF 'as long as we have input records sinMark(1) = !P1 + !P2 + !P3 + !D1 + !M1 + !M2 furMark(1) = !P4 + !P5 + !P6 + !M3 + !S1 + !S2 '################ 'and repeat for sinMark(2, 3, ...9), furMark(2, 3, ...9) '################ 'at this stage we have totals for the current student 'for each of the SingleMaths permitted combos plus the 'corresponding sum for the remaining marks 'convert to grades For loupe = 1 To 9 Select Case sinMark(loupe) Case Is < 240 sinGrad(loupe) = "F" Case Is < 300 sinGrad(loupe) = "E" Case Is < 360 sinGrad(loupe) = "D" Case Is < 420 sinGrad(loupe) = "C" Case Is < 480 sinGrad(loupe) = "B" Case Else sinGrad(loupe) = "A" End Select Select Case furMark(loupe) Case Is < 240 furGrad(loupe) = "F" Case Is < 300 furGrad(loupe) = "E" Case Is < 360 furGrad(loupe) = "D" Case Is < 420 furGrad(loupe) = "C" Case Is < 480 furGrad(loupe) = "B" Case Else furGrad(loupe) = "A" End Select Next 'convert to UCAS For loupe = 1 To 9 Select Case sinGrad(loupe) Case "A" sinUcas(loupe) = 12 Case "B" sinUcas(loupe) = 10 Case "C" sinUcas(loupe) = 8 Case "D" sinUcas(loupe) = 6 Case "E" sinUcas(loupe) = 4 Case "F" sinUcas(loupe) = 2 End Select Select Case furGrad(loupe) Case "A" furUcas(loupe) = 12 Case "B" furUcas(loupe) = 10 Case "C" furUcas(loupe) = 8 Case "D" furUcas(loupe) = 6 Case "E" furUcas(loupe) = 4 Case "F" furUcas(loupe) = 2 End Select Next 'find the best sinUcas topSinUcas = sinUcas(1) topSinPlusFurUcas = topSinUcas + furUcas(1) optimum = 1 ' cos we got to start somewhere For loupe = 2 To 9 If sinUcas(loupe) > topSinUcas Then topSinUcas = sinUcas(loupe) topSinPlusFurUcas = topSinUcas + furUcas(loupe) optimum = loupe Else If sinUcas(loupe) = topSinUcas Then If topSinUcas + furUcas(loupe) > topSinPlusFurUcas Then 'ANOTHER STUPID ERROR. NEED TO ADD: topSinUcas = sinUcas(loupe) topSinPlusFurUcas = topSinUcas + furUcas(loupe) optimum = loupe End If End If End If Next 'optimum now points 1...9 where 'SingleMaths is max AND FurtherMaths is max for that SingleMaths value 'other solutions may exist, but they are NOT better reco.AddNew reco!studentID = !studentID reco!SingleMaths = sinUcas(optimum) reco!FurtherMaths = furUcas(optimum) reco!scheme = optimum reco.Update .MoveNext Loop 'ERROR IN THE ORIGINAL POST , need to ADD end with 'OR IT WONT WORK End Sub
Last edited by izyrider; 091103 at 15:39.

091103, 15:48 #5Cavalier King Charles
 Join Date
 Dec 2002
 Location
 Préverenges, Switzerland
 Posts
 3,740
Code:'DECIDED I DIDN'T LIKE THIS BIT ' 'find the best sinUcas ' topSinUcas = sinUcas(1) ' topSinPlusFurUcas = topSinUcas + furUcas(1) ' optimum = 1 ' ' cos we got to start somewhere ' ' For loupe = 2 To 9 ' If sinUcas(loupe) > topSinUcas Then ' topSinUcas = sinUcas(loupe) ' topSinPlusFurUcas = topSinUcas + furUcas(loupe) ' optimum = loupe ' Else ' If sinUcas(loupe) = topSinUcas Then ' If topSinUcas + furUcas(loupe) > topSinPlusFurUcas 'Then ''ANOTHER STUPID ERROR. NEED TO ADD: ' topSinUcas = sinUcas(loupe) 'topSinPlusFurUcas = topSinUcas + furUcas(loupe) ' optimum = loupe ' End If ' End If ' End If ' Next 'REPLACE WITH: 'find the best sinUcas optimum = 1 'cos we must start somewhere for loupe = 1 to 9 if sinUcas(loupe) > sinUcas(optimum) then optimum = loupe else if sinUcas(loupe) = sinUcas(optimum) then if sinUcas(loupe) + furUcas(loupe) > sinUcas(optimum) + furUcas(optimum) then optimum = loupe endif endif endif Next 'AND CAN ALSO DELETE THE Dim topSinUcas and Dim topSinPlusFurUcas

091103, 16:53 #6Registered User
 Join Date
 Sep 2003
 Location
 London, England
 Posts
 52
Thank you very much, this looks just the type of program I was hoping to see. I won't have time to check it out 'til the weekend but it looks really good.

091203, 03:00 #7Cavalier King Charles
 Join Date
 Dec 2002
 Location
 Préverenges, Switzerland
 Posts
 3,740
hope it works out for you.
just one additional thought that occurred to me while i was asleep:
the convert to grades bit might be dangerous: the case else sets the default grade to "A". if there is some sort of error in calculating sinMark or furMark, the student automatically gets an "A"
maybe better isCode:Case Is < 480 sinGrad(loupe) = "B" Case is < 601 sinGrad(loupe) = "A" Case Else msgbox "error with " & !studentID & " grade" exit sub End Select
izyLast edited by izyrider; 091203 at 03:02.

091203, 15:17 #8Registered User
 Join Date
 Sep 2003
 Location
 London, England
 Posts
 52
Because I have never used VBA I am just guessing at what to do, so here is my attempt at completing the code you so kindly wrote (I have added a few questions as comments); Also, in Access 2000, do I use a macro with Action "RunCode" and Function Name "[Forms]![Main Switchboard].[optimiseResults]" to execute this program? If not what should I do?
I have copied this VBA code into the (General) section and called it a Public Sub. Is that the right thing to have done?
Public Sub optimiseResults()
'assuming integer fields are P1, P2, P3, P4, P5, P6, D1, M1, M2, M3, S1, S2
Dim sinMark(1 To 9) As Integer 'SingleMaths sum(mark)
Dim furMark(1 To 9) As Integer 'FurtherMaths sum(mark)
Dim sinGrad(1 To 9) As String * 1 'SingleMaths grade
Dim furGrad(1 To 9) As String * 1 'FurtherMaths grade
Dim sinUcas(1 To 9) As Integer 'SingleMaths UCAS
Dim furUcas(1 To 9) As Integer 'FurtherMaths UCAS
'shall I delete the next two lines?
Dim topSinUcas As Integer
Dim topSinPlusFurUcas As Integer
Dim optimum As Integer
Dim loupe As Integer 'a loop counter
'using DAO syntax: either convert to ADO or include reference to
'the DAO library: altF11 / Tools / References and scroll down
'to Microsoft DAO 3.6 library and "tick" it
' Please explain the above text, I really don't understand it.
Dim dabs As dao.database
'ERROR IN THE ORIGINAL POST: THIS IS GARBAGE:
'Dim reci As DAO.database 'input recordset
'Dim reco As DAO.database 'output database
'REPLACE WITH:
Dim reci As dao.Recordset
Dim reco As dao.Recordset
Dim strSQL As String
'construct SQL to pull StudentID, P1, P2, P3 etc
'if * wont do it, the details are left as an exercise for the reader
strSQL = "SELECT * FROM FM_Table"
'I have made a table called FM_Table that contains StudentID, P1, P2, P3 etc
Set dabs = CurrentDb
Set reci = dabs.OpenRecordset(strSQL)
Set reco = dabs.OpenRecordset("outputTable")
With reci
.MoveFirst 'this is not necessary, just my paranoia!
'loop through input record for each student
Do While Not .EOF 'as long as we have input records
sinMark(1) = !P1 + !P2 + !P3 + !D1 + !M1 + !M2
furMark(1) = !P4 + !P5 + !P6 + !M3 + !S1 + !S2
sinMark(2) = !P1 + !P2 + !P3 + !D1 + !S1 + !M2
furMark(2) = !P4 + !P5 + !P6 + !M3 + !M1 + !S2
sinMark(3) = !P1 + !P2 + !P3 + !M1 + !S1 + !M2
furMark(3) = !P4 + !P5 + !P6 + !M3 + !D1 + !S2
sinMark(4) = !P1 + !P2 + !P3 + !D1 + !M1 + !M3
furMark(4) = !P4 + !P5 + !P6 + !M2 + !S1 + !S2
sinMark(5) = !P1 + !P2 + !P3 + !D1 + !S1 + !M3
furMark(5) = !P4 + !P5 + !P6 + !M1 + !M2 + !S1
sinMark(6) = !P1 + !P2 + !P3 + !M1 + !S1 + !M3
furMark(6) = !P4 + !P5 + !P6 + !D1 + !M2 + !S2
sinMark(7) = !P1 + !P2 + !P3 + !D1 + !M1 + !S2
furMark(7) = !P4 + !P5 + !P6 + !M2 + !M3 + !S1
sinMark(8) = !P1 + !P2 + !P3 + !D1 + !S1 + !S2
furMark(8) = !P4 + !P5 + !P6 + !M1 + !M2 + !M3
sinMark(9) = !P1 + !P2 + !P3 + !M1 + !S1 + !S2
furMark(9) = !P4 + !P5 + !P6 + !M2 + !M3 + !D1
'at this stage we have totals for the current student
'for each of the SingleMaths permitted combos plus the
'corresponding sum for the remaining marks
'convert to grades
For loupe = 1 To 9
Select Case sinMark(loupe)
Case Is < 240
sinGrad(loupe) = "F"
Case Is < 300
sinGrad(loupe) = "E"
Case Is < 360
sinGrad(loupe) = "D"
Case Is < 420
sinGrad(loupe) = "C"
Case Is < 480
sinGrad(loupe) = "B"
Case Is < 601
sinGrad(loupe) = "A"
Case Else
MsgBox "error with " & !studentID & " grade"
Exit Sub
End Select
Select Case furMark(loupe)
Case Is < 240
furGrad(loupe) = "F"
Case Is < 300
furGrad(loupe) = "E"
Case Is < 360
furGrad(loupe) = "D"
Case Is < 420
furGrad(loupe) = "C"
Case Is < 480
furGrad(loupe) = "B"
Case Is < 601
furGrad(loupe) = "A"
Case Else
MsgBox "error with " & !studentID & " grade"
Exit Sub
End Select
Next
'convert to UCAS
For loupe = 1 To 9
Select Case sinGrad(loupe)
Case "A"
sinUcas(loupe) = 12
Case "B"
sinUcas(loupe) = 10
Case "C"
sinUcas(loupe) = 8
Case "D"
sinUcas(loupe) = 6
Case "E"
sinUcas(loupe) = 4
Case "F"
sinUcas(loupe) = 2
End Select
Select Case furGrad(loupe)
Case "A"
furUcas(loupe) = 12
Case "B"
furUcas(loupe) = 10
Case "C"
furUcas(loupe) = 8
Case "D"
furUcas(loupe) = 6
Case "E"
furUcas(loupe) = 4
Case "F"
furUcas(loupe) = 2
End Select
Next
'find the best sinUcas
optimum = 1 'cos we must start somewhere
For loupe = 1 To 9
If sinUcas(loupe) > sinUcas(optimum) Then
optimum = loupe
Else
If sinUcas(loupe) = sinUcas(optimum) Then
If sinUcas(loupe) + furUcas(loupe) > sinUcas(optimum) + furUcas(optimum) Then
optimum = loupe
End If
End If
End If
Next
'optimum now points 1...9 where
'SingleMaths is max AND FurtherMaths is max for that SingleMaths value
'other solutions may exist, but they are NOT better
reco.AddNew
reco!studentID = !studentID
reco!SingleMaths = sinUcas(optimum)
reco!FurtherMaths = furUcas(optimum)
reco!scheme = optimum
reco.Update
.MoveNext
Loop
'ERROR IN THE ORIGINAL POST , need to ADD
End With
'OR IT WONT WORK
End Sub

091303, 04:12 #9Cavalier King Charles
 Join Date
 Dec 2002
 Location
 Préverenges, Switzerland
 Posts
 3,740
here's my final version (if anything ever is "final")
i really know nothing about access macros. i would use a form with a command button and in the _Click() event of that button....
Private Sub whateverButton_Click()
optimiseResults
End Sub
i would also have optimiseResults() in the same form and change it back to Private, but this is only academic
finally (that word again!). if you decide to clear the output table, the simplest is to save an access delete query and run it at the top of optimiseResults like so
Public Sub optimiseResults()
'delete all records in output table
docmd.setwarnings false 'optional: switch off access' warning msgs
docmd.openquery "nameOfDeleteQuery"
docmd.setwarnings true 'switch warning msgs on again
.....and then the rest of the code
izy
Code:Public Sub optimiseResults() 'assuming integer fields are P1, P2, P3, P4, P5, P6, D1, M1, M2, M3, S1, S2 Dim sinMark(1 To 9) As Integer 'SingleMaths sum(mark) Dim furMark(1 To 9) As Integer 'FurtherMaths sum(mark) Dim sinGrad(1 To 9) As String * 1 'SingleMaths grade Dim furGrad(1 To 9) As String * 1 'FurtherMaths grade Dim sinUcas(1 To 9) As Integer 'SingleMaths UCAS Dim furUcas(1 To 9) As Integer 'FurtherMaths UCAS Dim optimum As Integer 'index in above arrays with optimum results Dim loupe As Integer 'a loop counter 'i am using DAO syntax: either convert to ADO or include reference to 'the DAO library: altF11 / Tools / References and scroll down 'to Microsoft DAO 3.6 library and "tick" it ' Please explain the above text, I really don't understand it. 'ignore what "DAO" and "ADO" are. 'with a2k, mr gates has determined that we will all move to "ADO" to address 'our databases. i am an old fart and i still use "DAO" (from a95, a97). 'a2k installs by default with ADO. The next three lines use DAO constructs 'to declare the database & recordsets: a standard install of a2k will 'throw an error message to do with "user defined types" because it will 'not understand what a DAO.Recordset is. 'a2k includes a "compatibility library" for DAO: to get a2k to "understand" 'DAO you need to create a reference to this compatibility library. 'open ANY code window in your application (AltF11 will do this), and on the 'code window menu bar select Tools / References. 'scroll down the list of "libraries" to Microsoft DAO 3.6 and check the checkbox. '...the current application will now understand DAO 'the alternative to this is to lookup the ADO constructs for declaring 'a database & recordset and replace the next three lines. 'you will find rumours that DAO is faster than ADO  don't know if it is really 'true and since i didn't learn the ADO syntax yet, i can't really check '...either way, DAO works fine once you reference the compatibility library. Dim dabs As DAO.Database Dim reci As DAO.Recordset Dim reco As DAO.Recordset Dim strSQL As String 'construct SQL to pull StudentID, P1, P2, P3 etc 'if * wont do it, the details are left as an exercise for the reader strSQL = "SELECT * FROM FM_Table" 'I have made a table called FM_Table that contains StudentID, P1, P2, P3 etc '...so * will do fine Set dabs = CurrentDb Set reci = dabs.OpenRecordset(strSQL) Set reco = dabs.OpenRecordset("outputTable") With reci .MoveFirst 'this is not necessary, just my paranoia! 'loop through input record for each student Do While Not .EOF 'as long as we have input records 'define totals for schemes 1...9 sinMark(1) = !P1 + !P2 + !P3 + !D1 + !M1 + !M2 furMark(1) = !P4 + !P5 + !P6 + !M3 + !S1 + !S2 sinMark(2) = !P1 + !P2 + !P3 + !D1 + !S1 + !M2 furMark(2) = !P4 + !P5 + !P6 + !M3 + !M1 + !S2 sinMark(3) = !P1 + !P2 + !P3 + !M1 + !S1 + !M2 furMark(3) = !P4 + !P5 + !P6 + !M3 + !D1 + !S2 sinMark(4) = !P1 + !P2 + !P3 + !D1 + !M1 + !M3 furMark(4) = !P4 + !P5 + !P6 + !M2 + !S1 + !S2 sinMark(5) = !P1 + !P2 + !P3 + !D1 + !S1 + !M3 furMark(5) = !P4 + !P5 + !P6 + !M1 + !M2 + !S1 sinMark(6) = !P1 + !P2 + !P3 + !M1 + !S1 + !M3 furMark(6) = !P4 + !P5 + !P6 + !D1 + !M2 + !S2 sinMark(7) = !P1 + !P2 + !P3 + !D1 + !M1 + !S2 furMark(7) = !P4 + !P5 + !P6 + !M2 + !M3 + !S1 sinMark(8) = !P1 + !P2 + !P3 + !D1 + !S1 + !S2 furMark(8) = !P4 + !P5 + !P6 + !M1 + !M2 + !M3 sinMark(9) = !P1 + !P2 + !P3 + !M1 + !S1 + !S2 furMark(9) = !P4 + !P5 + !P6 + !M2 + !M3 + !D1 'at this stage we have totals for the current student 'for each of the SingleMaths permitted combos plus the 'corresponding sum for the remaining marks 'convert to grades 'you could convert directly to UCAS here 'but you had the twostep in your original and maybe you 'want to save the grades (see how later) for your eventual 'report to the students. For loupe = 1 To 9 Select Case sinMark(loupe) Case Is < 240 sinGrad(loupe) = "F" Case Is < 300 sinGrad(loupe) = "E" Case Is < 360 sinGrad(loupe) = "D" Case Is < 420 sinGrad(loupe) = "C" Case Is < 480 sinGrad(loupe) = "B" Case Is < 601 sinGrad(loupe) = "A" Case Else MsgBox "error with " & !studentID & " grade" Exit Sub End Select Select Case furMark(loupe) Case Is < 240 furGrad(loupe) = "F" Case Is < 300 furGrad(loupe) = "E" Case Is < 360 furGrad(loupe) = "D" Case Is < 420 furGrad(loupe) = "C" Case Is < 480 furGrad(loupe) = "B" Case Is < 601 furGrad(loupe) = "A" Case Else MsgBox "error with " & !studentID & " grade" Exit Sub End Select Next 'convert to UCAS For loupe = 1 To 9 Select Case sinGrad(loupe) Case "A" sinUcas(loupe) = 12 Case "B" sinUcas(loupe) = 10 Case "C" sinUcas(loupe) = 8 Case "D" sinUcas(loupe) = 6 Case "E" sinUcas(loupe) = 4 Case "F" sinUcas(loupe) = 2 End Select Select Case furGrad(loupe) Case "A" furUcas(loupe) = 12 Case "B" furUcas(loupe) = 10 Case "C" furUcas(loupe) = 8 Case "D" furUcas(loupe) = 6 Case "E" furUcas(loupe) = 4 Case "F" furUcas(loupe) = 2 End Select Next 'find the best sinUcas optimum = 1 'cos we must start somewhere For loupe = 2 To 9 'ooops! no need for 1 in the loop If sinUcas(loupe) > sinUcas(optimum) Then optimum = loupe Else If sinUcas(loupe) = sinUcas(optimum) Then If furUcas(loupe) > furUcas(optimum) Then 'redundancy removed optimum = loupe End If End If End If Next 'optimum now points to scheme 1...9 where 'SingleMaths is max AND FurtherMaths is max for that SingleMaths value 'other solutions may exist, but they are NOT better reco.AddNew 'append new record reco!studentID = !studentID 'enter some values reco!SingleMaths = sinUcas(optimum) reco!FurtherMaths = furUcas(optimum) reco!scheme = optimum 'note also that you can save any of the other current variables 'if you have a suitable field in the table. use: ' reco!thefieldName = theVariableName(indexIfThereIsOne) ' etc ' etc reco.Update 'save the new record .MoveNext Loop End With Set reco = Nothing 'paranoia again, but it is "correct" to clear objects Set reci = Nothing Set dabs = Nothing End Sub

091303, 10:21 #10Registered User
 Join Date
 Sep 2003
 Location
 London, England
 Posts
 52
The final product, and it works perfectly!
Thanks for all your excellent help, izy
Private Sub FM_Click()
optimiseResults
On Error GoTo Err_FM_Click
Exit_FM_Click:
Exit Sub
Err_FM_Click:
MsgBox Err.Description
Resume Exit_FM_Click
End Sub
Private Sub optimiseResults()
'delete all records in output table
DoCmd.SetWarnings False 'switch off access warning msgs
Dim SQL As String
SQL = "DELETE FM_Table2.* FROM FM_Table2"
DoCmd.RunSQL SQL
DoCmd.SetWarnings True 'switch warning msgs on again
Dim sinMark(1 To 9) As Integer 'SingleMaths sum(mark)
Dim furMark(1 To 9) As Integer 'FurtherMaths sum(mark)
Dim sinGrad(1 To 9) As String * 1 'SingleMaths grade
Dim furGrad(1 To 9) As String * 1 'FurtherMaths grade
Dim sinUcas(1 To 9) As Integer 'SingleMaths UCAS
Dim furUcas(1 To 9) As Integer 'FurtherMaths UCAS
Dim optimum As Integer 'index in above arrays with optimum results
Dim loupe As Integer 'a loop counter
Dim dabs As DAO.Database
Dim reci As DAO.Recordset
Dim reco As DAO.Recordset
Dim strSQL As String
'construct SQL to pull Number, P1, P2, P3 etc
strSQL = "SELECT FM_Table1.* FROM FM_Table1"
'note that FM_Table contains Number, P1, P2, P3 etc
Set dabs = CurrentDb
Set reci = dabs.OpenRecordset(strSQL)
Set reco = dabs.OpenRecordset("FM_Table2")
With reci
.MoveFirst 'this is not necessary, just my paranoia!
'loop through input record for each student
Do While Not .EOF 'as long as we have input records
'define totals for schemes 1...9
sinMark(1) = !P1 + !P2 + !P3 + !D1 + !M1 + !M2
furMark(1) = !P4 + !P5 + !P6 + !M3 + !S1 + !S2
sinMark(2) = !P1 + !P2 + !P3 + !D1 + !S1 + !M2
furMark(2) = !P4 + !P5 + !P6 + !M3 + !M1 + !S2
sinMark(3) = !P1 + !P2 + !P3 + !M1 + !S1 + !M2
furMark(3) = !P4 + !P5 + !P6 + !M3 + !D1 + !S2
sinMark(4) = !P1 + !P2 + !P3 + !D1 + !M1 + !M3
furMark(4) = !P4 + !P5 + !P6 + !M2 + !S1 + !S2
sinMark(5) = !P1 + !P2 + !P3 + !D1 + !S1 + !M3
furMark(5) = !P4 + !P5 + !P6 + !M1 + !M2 + !S1
sinMark(6) = !P1 + !P2 + !P3 + !M1 + !S1 + !M3
furMark(6) = !P4 + !P5 + !P6 + !D1 + !M2 + !S2
sinMark(7) = !P1 + !P2 + !P3 + !D1 + !M1 + !S2
furMark(7) = !P4 + !P5 + !P6 + !M2 + !M3 + !S1
sinMark(8) = !P1 + !P2 + !P3 + !D1 + !S1 + !S2
furMark(8) = !P4 + !P5 + !P6 + !M1 + !M2 + !M3
sinMark(9) = !P1 + !P2 + !P3 + !M1 + !S1 + !S2
furMark(9) = !P4 + !P5 + !P6 + !M2 + !M3 + !D1
'at this stage we have totals for the current student
'for each of the SingleMaths permitted combos plus the
'corresponding sum for the remaining marks
'convert to grades
'you could convert directly to UCAS here
'but you may want to save the grades (see how later)
'for your eventual report to the students.
For loupe = 1 To 9
Select Case sinMark(loupe)
Case Is < 240
sinGrad(loupe) = "F"
Case Is < 300
sinGrad(loupe) = "E"
Case Is < 360
sinGrad(loupe) = "D"
Case Is < 420
sinGrad(loupe) = "C"
Case Is < 480
sinGrad(loupe) = "B"
Case Is < 601
sinGrad(loupe) = "A"
Case Else
MsgBox "error with " & !Number & " grade"
Exit Sub
End Select
Select Case furMark(loupe)
Case Is < 240
furGrad(loupe) = "F"
Case Is < 300
furGrad(loupe) = "E"
Case Is < 360
furGrad(loupe) = "D"
Case Is < 420
furGrad(loupe) = "C"
Case Is < 480
furGrad(loupe) = "B"
Case Is < 601
furGrad(loupe) = "A"
Case Else
MsgBox "error with " & !Number & " grade"
Exit Sub
End Select
Next
'convert to UCAS
For loupe = 1 To 9
Select Case sinGrad(loupe)
Case "A"
sinUcas(loupe) = 12
Case "B"
sinUcas(loupe) = 10
Case "C"
sinUcas(loupe) = 8
Case "D"
sinUcas(loupe) = 6
Case "E"
sinUcas(loupe) = 4
Case "F"
sinUcas(loupe) = 2
End Select
Select Case furGrad(loupe)
Case "A"
furUcas(loupe) = 12
Case "B"
furUcas(loupe) = 10
Case "C"
furUcas(loupe) = 8
Case "D"
furUcas(loupe) = 6
Case "E"
furUcas(loupe) = 4
Case "F"
furUcas(loupe) = 2
End Select
Next
'find the best sinUcas
optimum = 1 'cos we must start somewhere
For loupe = 2 To 9 'no need for 1 in the loop
If sinUcas(loupe) > sinUcas(optimum) Then
optimum = loupe
Else
If sinUcas(loupe) = sinUcas(optimum) Then
If furUcas(loupe) > furUcas(optimum) Then
optimum = loupe
End If
End If
End If
Next
'optimum now points to scheme 1...9 where
'SingleMaths is max AND FurtherMaths is max for that SingleMaths value
'other solutions may exist, but they are NOT better
reco.AddNew 'append new record
reco!Number = !Number 'enter some values
reco!SingleMaths = sinUcas(optimum)
reco!FurtherMaths = furUcas(optimum)
reco!scheme = optimum
reco!sinGrad = sinGrad(optimum)
reco!furGrad = furGrad(optimum)
'note also that you can save any of the other current variables
'if you have a suitable field in the output table. use:
' reco!thefieldName = theVariableName(indexIfThereIsOne)
' etc
' etc
reco.Update 'save the new record
.MoveNext
Loop
End With
Set reco = Nothing 'paranoia again, but it is "correct" to clear objects
Set reci = Nothing
Set dabs = Nothing
End Sub