I am trying to work out a competition schdule using excel

I could have any where from 10 to 14 Players and the spreadsheet will be set
up as follows

Column A will be the player numbers (10 to 14) and column B will also be 10
to 14

is there any way to code it so that it can produce a schedule where each
player plays every other player once and if I adjust he number (ie only 12
players) I can recaculate the schedule

thanks

I'm not sure what column B has to do with anything. From the phrase
"every player playes every other player once" it sounds like a classic
round-robin tournament in which every player in column A plays every
other in column A exactly once hence column B is redundant. If this is
not the case - please explain what you mean (the other interpretation I
can think of is that columns A and B represent disjoint lists of
players and you want a schedule in which every player in A plays every
player in B exactly once - which is much easier to arrange than a round
robin)

Assuming you want a round robin, copy this into a standard code module:


Const dummy = "this_is_not_a_player" 'for byes

Function Rotate(A As Variant) As Variant
'assumes A is 0-based with an even number
'of elements (=2)

Dim i As Long, n As Long
Dim NewA As Variant

n = UBound(A)
ReDim NewA(0 To n)
NewA(0) = A(0)
For i = 1 To (n - 1) / 2 - 1
NewA(i) = A(i + 1)
Next i
NewA((n - 1) / 2) = A(n)
For i = (n + 1) / 2 + 1 To n
NewA(i) = A(i - 1)
Next i
NewA((n + 1) / 2) = A(1)
Rotate = NewA
End Function

Sub DisplayRound(RoundNum As Long, StartCell As Range, A As Variant)
'A is the round vector
Dim ByePlayer As Variant
Dim i As Long, j As Long
Dim n As Long

StartCell.Value = "Round " & RoundNum
n = (UBound(A) + 1) / 2 'number of pairs
j = 1
For i = 0 To n - 1
If A(i) < dummy And A(i + n) < dummy Then
StartCell.Offset(j).Value = A(i) & " vs " & A(i + n)
j = j + 1
ElseIf A(i) = dummy Then
ByePlayer = A(i + n)
Else
ByePlayer = A(i)
End If
Next i
If Not IsEmpty(ByePlayer) Then
StartCell.Offset(j) = "Bye: " & ByePlayer
End If
End Sub

Sub RoundRobin()
Dim Players As Range, OutCell As Range
Dim i As Long, n As Long
Dim NumPairs As Long
Dim A As Variant 'round vector

Set Players = Application.InputBox( _
Prompt:="With mouse select column of players", _
Type:=8)
If Players.Columns.Count < 1 Then
MsgBox "Players must be in a single column"
Exit Sub
End If
Set OutCell = Application.InputBox( _
Prompt:="Select cell to start output in", _
Type:=8)
If OutCell.Cells.Count 1 Then
Set OutCell = OutCell.Cells(1) 'what they meant?
End If
n = Players.Cells.Count
If n Mod 2 = 0 Then
ReDim A(0 To n - 1)
Else
ReDim A(0 To n) 'will be byes
End If
For i = 0 To n - 1
A(i) = Players.Cells(i + 1)
Next i
If n Mod 2 = 1 Then
A(n) = dummy
NumPairs = (n + 1) / 2
Else
NumPairs = n / 2
End If
n = UBound(A)
For i = 0 To n - 1
DisplayRound i + 1, OutCell, A
A = Rotate(A)
OutCell.Offset(NumPairs + 1).Value = ""
Set OutCell = OutCell.Offset(NumPairs + 2)
Next i

End Sub


To use it you invoke RoundRobin() then first select the list of players
from one column (say column A) and then you select the cell in which
output is to begin (say C1). Make sure that your player selection
doesn't include a header like "Players"

HTH

-John Coleman

p.s. - I pulled the algorithm (which is apparently standard) from the
Wikipedia entry on round robin tournaments


Nigel wrote:
I am trying to work out a competition schdule using excel

I could have any where from 10 to 14 Players and the spreadsheet will be set
up as follows

Column A will be the player numbers (10 to 14) and column B will also be 10
to 14

is there any way to code it so that it can produce a schedule where each
player plays every other player once and if I adjust he number (ie only 12
players) I can recaculate the schedule

thanks

You're welcome. I'm still curious about the role of column B. Shortly
after I posted, I thought of a third natural interpretation of your
original post: there is only one set of players but for some reason
(maybe they belong to different divisions) the players are split into 2
columns. If this is the case then my requirement that the input be from
one column might be annoying and it would be easy enough for me to
modify the code to allow for the players to be split over several
columns.

-John Coleman

Nigel wrote:
Perfect

Thanks So Much

"John Coleman" wrote:

I'm not sure what column B has to do with anything. From the phrase
"every player playes every other player once" it sounds like a classic
round-robin tournament in which every player in column A plays every
other in column A exactly once hence column B is redundant. If this is
not the case - please explain what you mean (the other interpretation I
can think of is that columns A and B represent disjoint lists of
players and you want a schedule in which every player in A plays every
player in B exactly once - which is much easier to arrange than a round
robin)

Assuming you want a round robin, copy this into a standard code module:


Const dummy = "this_is_not_a_player" 'for byes

Function Rotate(A As Variant) As Variant
'assumes A is 0-based with an even number
'of elements (=2)

Dim i As Long, n As Long
Dim NewA As Variant

n = UBound(A)
ReDim NewA(0 To n)
NewA(0) = A(0)
For i = 1 To (n - 1) / 2 - 1
NewA(i) = A(i + 1)
Next i
NewA((n - 1) / 2) = A(n)
For i = (n + 1) / 2 + 1 To n
NewA(i) = A(i - 1)
Next i
NewA((n + 1) / 2) = A(1)
Rotate = NewA
End Function

Sub DisplayRound(RoundNum As Long, StartCell As Range, A As Variant)
'A is the round vector
Dim ByePlayer As Variant
Dim i As Long, j As Long
Dim n As Long

StartCell.Value = "Round " & RoundNum
n = (UBound(A) + 1) / 2 'number of pairs
j = 1
For i = 0 To n - 1
If A(i) < dummy And A(i + n) < dummy Then
StartCell.Offset(j).Value = A(i) & " vs " & A(i + n)
j = j + 1
ElseIf A(i) = dummy Then
ByePlayer = A(i + n)
Else
ByePlayer = A(i)
End If
Next i
If Not IsEmpty(ByePlayer) Then
StartCell.Offset(j) = "Bye: " & ByePlayer
End If
End Sub

Sub RoundRobin()
Dim Players As Range, OutCell As Range
Dim i As Long, n As Long
Dim NumPairs As Long
Dim A As Variant 'round vector

Set Players = Application.InputBox( _
Prompt:="With mouse select column of players", _
Type:=8)
If Players.Columns.Count < 1 Then
MsgBox "Players must be in a single column"
Exit Sub
End If
Set OutCell = Application.InputBox( _
Prompt:="Select cell to start output in", _
Type:=8)
If OutCell.Cells.Count 1 Then
Set OutCell = OutCell.Cells(1) 'what they meant?
End If
n = Players.Cells.Count
If n Mod 2 = 0 Then
ReDim A(0 To n - 1)
Else
ReDim A(0 To n) 'will be byes
End If
For i = 0 To n - 1
A(i) = Players.Cells(i + 1)
Next i
If n Mod 2 = 1 Then
A(n) = dummy
NumPairs = (n + 1) / 2
Else
NumPairs = n / 2
End If
n = UBound(A)
For i = 0 To n - 1
DisplayRound i + 1, OutCell, A
A = Rotate(A)
OutCell.Offset(NumPairs + 1).Value = ""
Set OutCell = OutCell.Offset(NumPairs + 2)
Next i

End Sub


To use it you invoke RoundRobin() then first select the list of players
from one column (say column A) and then you select the cell in which
output is to begin (say C1). Make sure that your player selection
doesn't include a header like "Players"

HTH

-John Coleman

p.s. - I pulled the algorithm (which is apparently standard) from the
Wikipedia entry on round robin tournaments


Nigel wrote:
I am trying to work out a competition schdule using excel

I could have any where from 10 to 14 Players and the spreadsheet will be set
up as follows

Column A will be the player numbers (10 to 14) and column B will also be 10
to 14

is there any way to code it so that it can produce a schedule where each
player plays every other player once and if I adjust he number (ie only 12
players) I can recaculate the schedule

thanks