## Abstract

If you need to organize a round robin tournament you can use this subroutine.
It implements the *circle method*:

An example for 6 players:

The VBA program - but not the worksheet function approach - also generates this kind of pairings table:

## Further Reading

Suksompong, W. (2018, April 11). Scheduling Asynchronous Round-Robin Tournaments. (External link!) https://arxiv.org/pdf/1804.04504.pdf

Abel, Finizio, Greig, Lewis (2003). Generalized whist tournament designs. (External link!) https://www.researchgate.net/publication/222140264_Generalized_whist_tournament_designs

Abel, Finizio, Greig, Morales (2008). Existence of (2, 8) GWhD(v) and (4, 8) GWhD(v) with v ≡ 0, 1 (mod 8). (External link!) https://www.researchgate.net/profile/Malcolm_Greig2/publication/257554633_Existence_of_2_8_GWhDv_and_4_8_GWhDv_with_v_equiv_01_mod_8/links/56f56a5f08ae7c1fda2ee68f.pdf

Richard A. DeVenezia’s homepage: (External link!) https://www.devenezia.com/downloads/round-robin/index.html

Ready-to-use tournament tables: (External link!) https://www.printyourbrackets.com/roundrobin.html

## Appendix – Solution with Excel Worksheet Functions

A simple solution approach with worksheet functions:

An interesting fact: You can use this approach for (almost) any number of players. Just copy the rows down as far as necessary and the columns to the right until you see empty cells.

These formulas even work for pathological cases of 0 players, 1 player, and 2 players.

An explanation of how the formulas were derived for this approach you can find here: Named Ranges Used in a Different Way erklärt.

Please read my Disclaimer.

sbRoundRobin.xlsx [20 KB Excel file, open and use at your own risk]

## Appendix – VBA Solution - sbRoundRobin Code

Please note that you need to include the SystemState class.

Please read my Disclaimer.

```
Option Explicit
Const CFirstOutputRow = 10
Sub sbRoundRobin()
'Creates a round robin tournament.
'Source (EN): http://www.sulprobil.com/sbroundrobin_en/
'Source (DE): http://www.bplumhoff.de/sbroundrobin_de/
'(C) (P) by Bernd Plumhoff 19-May-2023 PB V0.4
Dim bPause As Boolean
Dim c As Long
Dim c1 As Long 'Colours, 1 = White (Home game), 2 = Black (Away game)
Dim f As Long 'Player who has to pause
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long 'Number of players
Dim p As Long 'Number of players who can play
Dim r As Long 'Number of rounds
Dim t As Long 'Temporary storage during moves
Dim state As SystemState
'Initialize
Set state = New SystemState
n = Range("Number_of_Players")
c = Range("Player1_Game1")
wsR.Range(CFirstOutputRow & ":" & 16382 + CFirstOutputRow).EntireRow.Delete
If n < 2 Then
wsR.Cells(CFirstOutputRow, 1) = "'Number of players needs to be 2 or higher!"
Exit Sub
End If
If n > 16383 Then
wsR.Cells(CFirstOutputRow, 1) = "'Number of players needs to be 16383 or less!"
Exit Sub
End If
If c < 1 Or c > 2 Then
wsR.Cells(CFirstOutputRow, 1) = "'Colour of player 1 in game 1 needs to be 1 (White) or 2 (Black)!"
Exit Sub
End If
wsT.Cells.EntireRow.Delete
ReDim vR(1 To n + 1, 1 To n / 2 + 2) As Variant
ReDim vT(1 To n + 1, 1 To n + 1) As Variant
For i = 1 To n
vT(1 + i, 1) = "Player " & i
vT(1, 1 + i) = "Player " & i
vT(1 + i, 1 + i) = "'X"
Next i
c1 = c
If n Mod 2 = 0 Then
bPause = False
p = n
r = n - 1
Else
bPause = True
p = n - 1
r = n
End If
ReDim a(1 To p) As Long
For i = 1 To p
a(i) = i
Next i
j = 0
If bPause Then
f = n
vR(1, 2) = "Free"
j = 1
End If
For i = 1 To p / 2
vR(1, i + j + 1) = "Table " & i
Next i
For i = 1 To r
'Output of of current game pairings
vR(1 + i, 1) = "'Round " & i
j = 2
If bPause Then
vR(1 + i, j) = f & " pauses"
j = j + 1
End If
If c1 = 1 Then
vR(1 + i, j) = "'" & a(1) & " - " & a(UBound(a))
vT(1 + a(1), 1 + a(UBound(a))) = "Round " & i & ", Table 1, white"
vT(1 + a(UBound(a)), 1 + a(1)) = "Round " & i & ", Table 1, black"
Else
vR(1 + i, j) = "'" & a(UBound(a)) & " - " & a(1)
vT(1 + a(1), 1 + a(UBound(a))) = "Round " & i & ", Table 1, black"
vT(1 + a(UBound(a)), 1 + a(1)) = "Round " & i & ", Table 1, white"
End If
j = j + 1
For k = 2 To UBound(a) / 2
If (c + k) Mod 2 = 0 Then
vR(1 + i, j) = "'" & a(k) & " - " & a(UBound(a) - k + 1)
vT(1 + a(k), 1 + a(UBound(a) - k + 1)) = "Round " & i & ", Table " & k & ", white"
vT(1 + a(UBound(a) - k + 1), 1 + a(k)) = "Round " & i & ", Table " & k & ", black"
Else
vR(1 + i, j) = "'" & a(UBound(a) - k + 1) & " - " & a(k)
vT(1 + a(k), 1 + a(UBound(a) - k + 1)) = "Round " & i & ", Table " & k & ", black"
vT(1 + a(UBound(a) - k + 1), 1 + a(k)) = "Round " & i & ", Table " & k & ", white"
End If
j = j + 1
Next k
'Move on to next round
If bPause Then
t = f
f = a(UBound(a))
j = 2
Else
c1 = 3 - c1 'Switch colour for player 1
t = a(UBound(a))
j = 3
End If
For k = UBound(a) To j Step -1
a(k) = a(k - 1)
Next k
a(j - 1) = t
Next i
wsR.Range(wsR.Cells(CFirstOutputRow, 1), wsR.Cells(CFirstOutputRow + n, 2 + n / 2)) = vR
wsT.Range(wsT.Cells(1, 1), wsT.Cells(n + 1, n + 1)) = vT
wsT.Cells.EntireColumn.AutoFit
End Sub
```

Please read my Disclaimer.

sbRoundRobin.xlsm [35 KB Excel file, open and use at your own risk]