Random Selection

[R1chard]

I would like a macro which will draw football fixtures for me, at the click of a button.

I have 8 teams, which means 4 games will be played each week. I need a list of fixtures for the whole season. Each team plays each other twice, once at home and once away.

I want the home teams to display in column A and the Away teams in Column B

Rows 2 - 5 will display the fixtures in week 1
Rows 7 - 10 will display the fixtures for week 2
Rows 12 - 15 will display the fixtures in week 3

and so on

My teams are displayed in cells D1:D8

I hope I have explained this clearly.

 

[acw]

Hi

The following code may help. It is based on a structure:
Row 1 has the weeks, starting in C1 (C1 is W1, D1 is W2 etc)
Column B has the team numbers (B2 is 1, b3 is 2) etc

Run the code and enter the number of teams (8 in this case). It will build a matrix as per above

Sub aaa()
Range("b2:u21").Select
Selection.Clear
Range("b2").Select
teamno = Val(InputBox("how many", , 6))
If teamno Mod 2 <> 0 Then teamno = teamno + 1: hasby = True
Range("b2").Select

For i = 1 To teamno
ActiveCell.Offset(0, i - 1) = i
ActiveCell.Offset(i - 1, 0) = i
Next i


'put in the matches against team 1
For i = 1 To teamno - 1
ActiveCell.Offset(i, i).Value = 1
Next i

While ActiveCell.Value < teamno - 1

curvalue = ActiveCell.Value + 1
curteam = curvalue
rowoff = 1
While ActiveCell.Value <> curteam + 1
ActiveCell.Offset(0, 1).Select
Wend
ActiveCell.Offset(1, 1).Select
While curvalue + 1 <= teamno
If ActiveCell.Column() = teamno + 2 Then
Cells(ActiveCell.Row, 2).Select
End If
If IsEmpty(ActiveCell) Then
ActiveCell.Value = curvalue + 1
curvalue = curvalue + 1
ActiveCell.Offset(rowoff, 0).Value = curteam
rowoff = rowoff + 1
End If
ActiveCell.Offset(0, 1).Select
Wend
Cells(ActiveCell.Row, 2).Select
Wend
If hasby Then
Range("c2", Range("c2").Offset(teamno - 2, teamno - 2)).Select
Selection.Replace what:=teamno, replacement:="B"
Range("b2").Offset(teamno - 1, 0).Select
Range(ActiveCell, ActiveCell.Offset(0, teamno - 1)).Clear
End If


Range("a1").Select
End Sub


Tony

 

[R1chard]

Hi Tony, Thanks for your help and reply. It does not display the results I need. I need each team to play each other once at home and once away. The macro you gave does not give me these results, it duplicates fixtures and also has them playing 2 different teams in the same week.

It generates the same result each time I run the code aswel, therefore the fixtures would be the same each season.

Thanks for having a look for me.

 

[acw]

Hi

1) For home and away, then just duplicate the first set of results.
2) Duplicates Fixtures???
3) Plays 2 different teams in the same week. I don't get that.

If you run the code with the default number (6), you will have a 2 in C2. This means that team 1 is playing team 2 in week 1. In cell C3 you have a 1 which is the reverse ie team 2 is playing team 1 in week 1.

What were you getting?


Tony

 

[Brian from Maui]

This thread isn't exactly what you're after, but it's a interesting thread on random scheduling,

http://www.mrexcel.com/board2/viewtopic.php?t=20231

 

[R1chard]

acw - that is what I was getting I just couldn't understand what was what and who was playing who. Thanks for all of your help

Brian from Maui - Thanks for that thread I will see if it is any use to me.

Thanks again to you both :wink: