Results 1 to 10 of 10
  1. #1
    Join Date
    Sep 2003
    Location
    London, England
    Posts
    52

    Question 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. #2
    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. #3
    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
    Thanks for your interest, the answer was in my question:
    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. #4
    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: 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
            
            
            '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; 09-11-03 at 15:39.

  5. #5
    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. #6
    Join Date
    Sep 2003
    Location
    London, England
    Posts
    52

    Smile

    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. #7
    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
                        sinGrad(loupe) = "B"
                    Case is < 601
                        sinGrad(loupe) = "A"
                     Case Else
                         msgbox "error with " & !studentID & " grade"
                          exit sub
                End Select
    and similarly for furGrad()

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

  8. #8
    Join Date
    Sep 2003
    Location
    London, England
    Posts
    52

    Question

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


    '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

  9. #9
    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: 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
                
                
                'convert to grades
                'you could convert directly to UCAS here
                'but you had the two-step 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

  10. #10
    Join Date
    Sep 2003
    Location
    London, England
    Posts
    52

    Cool

    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

Posting Permissions

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