Thread: VBA for use in Access 2000

1. Registered User
Join Date
Sep 2003
Location
London, England
Posts
52

Unanswered: VBA for use in Access 2000

Further Mathematics A Level Cash-in 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 cash-in 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 cash-in 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?

2. Cavalier 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

3. Registered 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

4. Cavalier 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 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: alt-F11 / 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

For loupe = 1 To 9

Select Case sinMark(loupe)
Case Is < 240
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Else
End Select

Select Case furMark(loupe)
Case Is < 240
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Else
End Select

Next

'convert to UCAS
For loupe = 1 To 9

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

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!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; 09-11-03 at 15:39.

5. Cavalier 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```
izy

6. Registered 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.

7. Cavalier 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 is
Code:
```               Case Is < 480
Case is < 601
Case Else
msgbox "error with " & !studentID & " grade"
exit sub
End Select```

izy
Last edited by izyrider; 09-12-03 at 03:02.

8. Registered 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 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: alt-F11 / 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

For loupe = 1 To 9

Select Case sinMark(loupe)
Case Is < 240
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Is < 601
Case Else
MsgBox "error with " & !studentID & " grade"
Exit Sub
End Select

Select Case furMark(loupe)
Case Is < 240
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Is < 601
Case Else
MsgBox "error with " & !studentID & " grade"
Exit Sub
End Select

Next

'convert to UCAS
For loupe = 1 To 9

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

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!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

9. Cavalier 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 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: alt-F11 / 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 (Alt-F11 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

'you could convert directly to UCAS here
'report to the students.
For loupe = 1 To 9

Select Case sinMark(loupe)
Case Is < 240
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Is < 601
Case Else
MsgBox "error with " & !studentID & " grade"
Exit Sub
End Select

Select Case furMark(loupe)
Case Is < 240
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Is < 601
Case Else
MsgBox "error with " & !studentID & " grade"
Exit Sub
End Select

Next

'convert to UCAS
For loupe = 1 To 9

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

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!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```

10. Registered 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 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

'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
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Is < 601
Case Else
MsgBox "error with " & !Number & " grade"
Exit Sub
End Select

Select Case furMark(loupe)
Case Is < 240
Case Is < 300
Case Is < 360
Case Is < 420
Case Is < 480
Case Is < 601
Case Else
MsgBox "error with " & !Number & " grade"
Exit Sub
End Select

Next

'convert to UCAS
For loupe = 1 To 9

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

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!Number = !Number '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 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

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•