View Single Post
  #3   Report Post  
Bob Phillips
 
Posts: n/a
Default

PS this was for fourteen teams, here is a more generalised version for any
number of teams. It assumes an even number of teams, so if you have an odd
number, just add a dummy team then delete their fixtures (I am sure that it
could manage even or odd, but I don't have the inclination :-))

Const NumTeams As Long = 16

Sub RoundRobin()
Dim varr As Variant
Dim varr1(1 To NumTeams \ 2, 1 To 2)
Range("C:D").ClearContents
varr = Worksheets("sheet1").Range("A1:A" & NumTeams)
For i = 1 To (NumTeams - 1) * (NumTeams \ 2) + 1 Step (NumTeams \ 2) + 1
rotate varr
Split1 varr, varr1
Cells(i, 3).Resize((NumTeams \ 2), 2).Value = varr1
Next
Set rng = Cells(Rows.Count, 3).End(xlUp)(2)
Range(Range("C1"), rng).Copy rng.Offset(1, 1)
Range(Range("D1"), rng.Offset(0, 1)).Copy rng.Offset(1, 0)
End Sub


Sub Split1(arr1, arr2)
l = -1
For i = 1 To NumTeams
If i <= (NumTeams \ 2) Then
j = i
ii = i
k = 1
Else
l = l + 1
ii = NumTeams - l
j = i - (NumTeams \ 2)
k = 2
End If
arr2(j, k) = arr1(ii, 1)
Next
End Sub


Sub rotate(arr)
arr1 = arr
For i = 2 To NumTeams - 1
arr(i, 1) = arr1(i + 1, 1)
Next
arr(NumTeams, 1) = arr1(2, 1)
End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Bob Phillips" wrote in message
...
Here is a solution that was previously given by Tom Ogilvy.

Just mix up the combinations and assign dates.

Sub RoundRobin14()
Dim varr As Variant
Dim varr1(1 To 7, 1 To 2)
Range("C:D").ClearContents
varr = Worksheets("sheet1").Range("A1:A14")
For i = 1 To 13 * 8 Step 8
rotate varr
Split1 varr, varr1
Cells(i, 3).Resize(7, 2).Value = varr1
Next
Set rng = Cells(Rows.Count, 3).End(xlUp)(2)
Range(Range("C1"), rng).Copy rng.Offset(1, 1)
Range(Range("D1"), rng.Offset(0, 1)).Copy rng.Offset(1, 0)
End Sub


Sub Split1(arr1, arr2)
l = -1
For i = 1 To 14
If i <= 7 Then
j = i
ii = i
k = 1
Else
l = l + 1
ii = 14 - l
j = i - 7
k = 2
End If
arr2(j, k) = arr1(ii, 1)
Next
End Sub


Sub rotate(arr)
arr1 = arr
For i = 2 To 13
arr(i, 1) = arr1(i + 1, 1)
Next
arr(14, 1) = arr1(2, 1)
End Sub





--

HTH

RP
(remove nothere from the email address if mailing direct)


"Frazer Snowdon" wrote in

message
...
Hi,

How can I use Excel to create fixture lists for a sporting league?

I'm taking over the job from a colleague, but I don't know how to do it.

I
know that he gives each team a value, and then gets excel to

automatically
generate the fixtures for the whole season.

Is this easily possible?

FS