VB House Assignment

[Gemmalouise1988]

Hi everyone,
My most important college assignment to date seems pretty basic on the outside
but I'm sure this will interest a few of you.

If you see this document:
http://stair.stcoll.ac .uk/jowen/btecsd/pconc/docs/IVA1.pdf and take a brief look
to see what it's all about, (a fixtures and points system for a school) take a
look on page 3, to see the list of students with their names, house and class.

Then look on page 2 to see the rules set down to create these fixtures.

I have learnt that it is pretty impossible to create these fixtures using code
and would like to know your views.

There should be 18 matches per game (there are 4 games).

So far, I have managed to get 18 matches for 2 games, 17 for one game and 16 for
the last. This is because as you get to the end of the fixture assignment, you
run out of players to play each other.

I'm sure there is some mathematical way of working it out, and I am probably
going to leave my results how they are now as it is as good as it needs to be
for my assigment, but it interests me a lot and wondered if anyone else has an
easy way of implementing this program.

I will post my code here for you too, to take a quick look. Sorry if it is
crap/hard to read/whatever, just give me your views. If I could find out how to
code it properly for the hand in date (next thursday lol) then I suppose thats a
cool bonus.

Have fun!
Gisterogue

NOTE: I apologise.. we MUST use VB 6 :(

CODE: The Create fixtures form

Private Sub cmdMore_Click() 
 
'show results 
Me.Height = 8220 
Me.Top = Screen.Height / 2 - (Me.Height / 2) 
End Sub 
 
Private Sub Form_Load() 
 
Dim x As Integer 
Dim y As Integer 
Dim z As Integer 
Dim Method As Boolean 
Dim intArrayIndex As Integer 
 
Method = True 
 
'loop for every game 
For x = 1 To 4 
 
    'loop through every pupil 
 
    For y = UBound(Competitor) To LBound(Competitor) Step -1 
        'first check if their match is set 
        If Competitor(y).Games(x).Against = "" Then 
 
            'next find an opponent, to do this just check 
            '1) if the opponent already has a game or not 
            '2) if the opponent is in same class or house 
            '3) if opponent has already played this player or not 
 
If Method = False Then 
'''''''''''''''''''''''''''''''''''' 
            For z = UBound(Competitor) To LBound(Competitor) Step -1 
 
            If Not playedEachother(y, z) Then 
                If Competitor(z).Class <> Competitor(y).Class Then 
                    If Competitor(z).House <> Competitor(y).House And
Competitor(z).Class <> Competitor(y).Class Then 
                            If Competitor(z).Games(x).Against = "" Then 
 
                                'set player 
                                Competitor(y).Games(x).Against =
Competitor(z).Name 
                                'MsgBox Competitor(y).Games(x).Against 
                                'set other player too 
                                Competitor(z).Games(x).Against =
Competitor(y).Name 
                                'MsgBox Competitor(z).Games(x).Against 
 
                                txtMatches.Text = txtMatches.Text &
Competitor(y).Games(x).Type & ": " & Competitor(y).Name & " (House: " &
Competitor(y).House & " Class: " & Competitor(y).Class & ") vs " &
Competitor(z).Name & " (House: " & Competitor(z).House & " Class: " &
Competitor(z).Class & ")" & vbCrLf 
 
                                'escape from loop 
                                z = LBound(Competitor) - 1 
 
                            End If 
                    End If 
                End If 
            End If 
 
            Next 
 
            Method = Not Method 
''''''''''''''''''''''''''''''''''' 
Else 
            For z = LBound(Competitor) To UBound(Competitor) 
 
            If Not playedEachother(y, z) Then 
                If Competitor(z).Class <> Competitor(y).Class Then 
                    If Competitor(z).House <> Competitor(y).House And
Competitor(z).Class <> Competitor(y).Class Then 
                            If Competitor(z).Games(x).Against = "" Then 
 
                                'set player 
                                Competitor(y).Games(x).Against =
Competitor(z).Name 
                                'MsgBox Competitor(y).Games(x).Against 
                                'set other player too 
                                Competitor(z).Games(x).Against =
Competitor(y).Name 
                                'MsgBox Competitor(z).Games(x).Against 
 
                                txtMatches.Text = txtMatches.Text &
Competitor(y).Games(x).Type & ": " & Competitor(y).Name & " (House: " &
Competitor(y).House & " Class: " & Competitor(y).Class & ") vs " &
Competitor(z).Name & " (House: " & Competitor(z).House & " Class: " &
Competitor(z).Class & ")" & vbCrLf 
 
                                'escape from loop 
                                z = UBound(Competitor) + 1 
 
                            End If 
                    End If 
                End If 
            End If 
 
            Next 
            Method = Not Method 
End If 
'''''''''''''''''''''''''''''''''' 
 
        End If 
 
    Next 
 
Next 
 
MsgBox "Your fixtures have been generated.", vbOKOnly, "Fixtures Generated" 
 
''''when fixtures are finished!!''' 
'show button 
Me.Height = 1725 
 
End Sub 
 
Private Function playedEachother(Player1Index As Integer, Player2Index As
Integer) As Boolean 
 
Dim x As Integer 
 
For x = 1 To 4 
 
    If Competitor(Player1Index).Games(x).Against = Competitor(Player2Index).Name
Then 
        If Competitor(Player1Index).Games(x).Against <> "" Or
Competitor(Player2Index).Games(x).Against <> "" Then 
            playedEachother = True 
            Exit Function 
        End If 
    End If 
 
Next 
 
playedEachother = False 
 
End Function 
 

code: the module I also have

'This module holds all the data needed 
'for the salchester primary school to run 
 
Option Explicit 
 
'hold users access level 
Public ACCESS_LEVEL As Integer 
'hold users current program section 
Public CURRENT_SECTION As Integer 
'hold correct username 
Public CORRECT_USERNAME As String 
'hold correct password 
Public CORRECT_PASSWORD As String 
'hold games 
Public Type Game 
    Type As String 
    Played As Boolean 
    Won As Boolean 
    Against As String 
End Type 
'hold pupils 
Public Type Player 
    Name As String 
    Class As Integer 
    House As String 
    Games(1 To 4) As Game 
    Available As Boolean 
End Type 
Public Competitor(1 To 36) As Player 
 
Public Sub Initialize() 
 
    'set default username and password 
    CORRECT_USERNAME = "user" 
    CORRECT_PASSWORD = "pass" 
 
    'set player details 
    Call setPlayerDefaults 
 
End Sub 
 
Private Sub setPlayerDefaults() 
 
'first set default games 
 
Dim x As Integer 
 
For x = LBound(Competitor) To UBound(Competitor) 
        Competitor(x).Games(1).Type = "Snap" 
        Competitor(x).Games(2).Type = "Cribbage" 
        Competitor(x).Games(3).Type = "Spillikins" 
        Competitor(x).Games(4).Type = "Junior Scrabble" 
Next 
 
'next set all the names and other data of competitors 
With Competitor(1) 
    .Name = "Albert" 
    .Class = 1 
    .House = "Yellow" 
End With 
 
With Competitor(2) 
    .Name = "Arnold" 
    .Class = 1 
    .House = "Green" 
End With 
 
With Competitor(3) 
    .Name = "Aswan" 
    .Class = 1 
    .House = "Yellow" 
End With 
 
With Competitor(4) 
    .Name = "Bertha" 
    .Class = 1 
    .House = "Green" 
End With 
 
With Competitor(5) 
    .Name = "Betty" 
    .Class = 1 
    .House = "Yellow" 
End With 
 
With Competitor(6) 
    .Name = "Bella" 
    .Class = 1 
    .House = "Green" 
End With 
 
With Competitor(7) 
    .Name = "Charles" 
    .Class = 2 
    .House = "Green" 
End With 
 
With Competitor(8) 
    .Name = "Colin" 
    .Class = 2 
    .House = "Yellow" 
End With 
 
With Competitor(9) 
    .Name = "Denise" 
    .Class = 2 
    .House = "Green" 
End With 
 
With Competitor(10) 
    .Name = "Debra" 
    .Class = 2 
    .House = "Yellow" 
End With 
 
With Competitor(11) 
    .Name = "Edward" 
    .Class = 3 
    .House = "Green" 
End With 
 
With Competitor(12) 
    .Name = "Elias" 
    .Class = 3 
    .House = "Yellow" 
End With 
 
With Competitor(13) 
    .Name = "Earl" 
    .Class = 3 
    .House = "Green" 
End With 
 
With Competitor(14) 
    .Name = "Felicity" 
    .Class = 3 
    .House = "Yellow" 
End With 
 
With Competitor(15) 
    .Name = "Freda" 
    .Class = 3 
    .House = "Green" 
End With 
 
With Competitor(16) 
    .Name = "Fiona" 
    .Class = 3 
    .House = "Yellow" 
End With 
 
With Competitor(17) 
    .Name = "George" 
    .Class = 4 
    .House = "Green" 
End With 
 
With Competitor(18) 
    .Name = "Gilbert" 
    .Class = 4 
    .House = "Yellow" 
End With 
 
With Competitor(19) 
    .Name = "Gerry" 
    .Class = 4 
    .House = "Green" 
End With 
 
With Competitor(20) 
    .Name = "Gwyn" 
    .Class = 4 
    .House = "Yellow" 
End With 
 
With Competitor(21) 
    .Name = "Harriet" 
    .Class = 4 
    .House = "Green" 
End With 
 
With Competitor(22) 
    .Name = "Hebe" 
    .Class = 4 
    .House = "Yellow" 
End With 
 
With Competitor(23) 
    .Name = "Helen" 
    .Class = 4 
    .House = "Green" 
End With 
 
With Competitor(24) 
    .Name = "Hilary" 
    .Class = 4 
    .House = "Yellow" 
End With 
 
With Competitor(25) 
    .Name = "Ian" 
    .Class = 5 
    .House = "Green" 
End With 
 
With Competitor(26) 
    .Name = "Idris" 
    .Class = 5 
    .House = "Yellow" 
End With 
 
With Competitor(27) 
    .Name = "Isaac" 
    .Class = 5 
    .House = "Green" 
End With 
 
With Competitor(28) 
    .Name = "Jane" 
    .Class = 5 
    .House = "Yellow" 
End With 
 
With Competitor(29) 
    .Name = "Jenny" 
    .Class = 5 
    .House = "Green" 
End With 
 
With Competitor(30) 
    .Name = "Jasmine" 
    .Class = 5 
    .House = "Yellow" 
End With 
With Competitor(31) 
    .Name = "Keith" 
    .Class = 6 
    .House = "Green" 
End With 
 
With Competitor(32) 
    .Name = "Kenny" 
    .Class = 6 
    .House = "Yellow" 
End With 
 
With Competitor(33) 
    .Name = "Kevin" 
    .Class = 6 
    .House = "Green" 
End With 
 
With Competitor(34) 
    .Name = "Laura" 
    .Class = 6 
    .House = "Yellow" 
End With 
 
With Competitor(35) 
    .Name = "Leila" 
    .Class = 6 
    .House = "Green" 
End With 
 
With Competitor(36) 
    .Name = "Linda" 
    .Class = 6 
    .House = "Yellow" 
End With 
 
End Sub

Thanks everyone!!

[debasisdas]

We are not here to do your home work.

Please follow the posting guidelines in every new post/reply.