If you need to organize a round robin tournament you can use this subroutine.
Please read my Disclaimer.
Option Explicit​Const CFirstOutputRow = 10​Sub sbRoundRobin()'Creates a round robin tournament.'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbroundrobin'V0.2 PB 30-Dec-2020 (C) (P) by Bernd PlumhoffDim bPause As BooleanDim c As Long, c1 As Long 'Colours, 1 = White (Home game), 2 = Black (Away game)Dim f As Long 'Player who has to pauseDim i As Long, j As Long, k As Long 'CountersDim n As Long 'Number of playersDim p As Long 'Number of players who can playDim r As Long 'Number of roundsDim t As Long 'Temporary storage during moves​'Initializen = Range("Number_of_Players")c = Range("Player1_Game1")wsR.Range(CFirstOutputRow & ":65536").EntireRow.Delete​If n < 2 ThenwsR.Cells(CFirstOutputRow, 1) = "'Number of players needs to be 2 or higher!"Exit SubEnd IfIf c < 1 Or c > 2 ThenwsR.Cells(CFirstOutputRow, 1) = "'Colour of player 1 in game 1 needs to 1 (White) or 2 (Black)!"Exit SubEnd If​wsT.Cells.EntireRow.DeleteFor i = 1 To nwsT.Cells(1 + i, 1) = "'Player " & iwsT.Cells(1, 1 + i) = "'Player " & iwsT.Cells(1 + i, 1 + i) = "'X"Next i​c1 = c​If n Mod 2 = 0 ThenbPause = Falsep = nr = n - 1ElsebPause = Truep = n - 1r = nEnd IfReDim a(1 To p) As LongFor i = 1 To pa(i) = iNext ij = 0If bPause Thenf = nwsR.Cells(CFirstOutputRow, 2) = "'Free"j = 1End IfFor i = 1 To p / 2wsR.Cells(CFirstOutputRow, i + j + 1) = "'Table " & iNext i​For i = 1 To r​'Output of of current game pairingswsR.Cells(CFirstOutputRow + i, 1) = "'Round " & ij = 2If bPause ThenwsR.Cells(CFirstOutputRow + i, j) = "'" & f & " pauses"j = j + 1End IfIf c1 = 1 ThenwsR.Cells(CFirstOutputRow + i, j) = "'" & a(1) & " - " & a(UBound(a))wsT.Cells(1 + a(1), 1 + a(UBound(a))) = "'Round " & i & ", Table 1, white"wsT.Cells(1 + a(UBound(a)), 1 + a(1)) = "'Round " & i & ", Table 1, black"ElsewsR.Cells(CFirstOutputRow + i, j) = "'" & a(UBound(a)) & " - " & a(1)wsT.Cells(1 + a(1), 1 + a(UBound(a))) = "'Round " & i & ", Table 1, black"wsT.Cells(1 + a(UBound(a)), 1 + a(1)) = "'Round " & i & ", Table 1, white"End Ifj = j + 1For k = 2 To UBound(a) / 2If (c + k) Mod 2 = 0 ThenwsR.Cells(CFirstOutputRow + i, j) = "'" & a(k) & " - " & a(UBound(a) - k + 1)wsT.Cells(1 + a(k), 1 + a(UBound(a) - k + 1)) = "'Round " & i & ", Table " & k & ", white"wsT.Cells(1 + a(UBound(a) - k + 1), 1 + a(k)) = "'Round " & i & ", Table " & k & ", black"ElsewsR.Cells(CFirstOutputRow + i, j) = "'" & a(UBound(a) - k + 1) & " - " & a(k)wsT.Cells(1 + a(k), 1 + a(UBound(a) - k + 1)) = "'Round " & i & ", Table " & k & ", black"wsT.Cells(1 + a(UBound(a) - k + 1), 1 + a(k)) = "'Round " & i & ", Table " & k & ", white"End Ifj = j + 1Next k'Move on to next roundIf bPause Thent = ff = a(UBound(a))For k = UBound(a) To 2 Step -1a(k) = a(k - 1)Next ka(1) = tElsec1 = 3 - c1 'Switch colour for player 1t = a(UBound(a))For k = UBound(a) To 3 Step -1a(k) = a(k - 1)Next ka(2) = tEnd If​Next i​wsT.Cells.EntireColumn.AutoFit​End Sub