help with combinations

[joeloveszoe]

hi~
i wonder if i can use excel for a pickleball league game generator

i have 9 players 2 courts

is there a formula i can use to generate games
2 games at a time - 4 player per court - 1 person sitting out

i want at least 10 -12 combinations
each game different partners / opponents and everyone gets a turn to sit out

for example
game 1
court A
player 1 player 2 vs player 3 player 4
court B
player 5 player 6 vs player 7 player 8

player 9 sits out

game 2
player 1 player 8 vs player 7 player 6
court B
player 2 player 3 vs player 4 player 9

player 5 sits out

thanks in advance for your help =)

 

[skillilea]

try this

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	Game	Court1	Court2	Sitting Out				Players
2								John
3	Game: 1	Emily	Daniel	Mary				Mary
4		Christopher	Sarah					David
5		David	Michael					Sarah
6		John	Jessica					Michael
7								Emily
8	Game: 2	Jessica	Sarah	David				Daniel
9		John	Mary					Jessica
10		Daniel	Christopher					Christopher
11		Emily	Michael
12
13	Game: 3	Daniel	John	Sarah
14		Michael	Emily
15		Jessica	David
16		Christopher	Mary
17
18	Game: 4	Daniel	John	Michael
19		Christopher	David
20		Sarah	Emily
21		Mary	Jessica
22
23	Game: 5	Sarah	David	Emily
24		John	Christopher
25		Jessica	Mary
26		Daniel	Michael
27
28	Game: 6	Michael	David	Daniel
29		Jessica	Christopher
30		Sarah	John
31		Emily	Mary
32
33	Game: 7	David	Emily	Jessica
34		Mary	Daniel
35		John	Christopher
36		Michael	Sarah
37
38	Game: 8	Sarah	Emily	John
39		Jessica	David
40		Daniel	Christopher
41		Michael	Mary
42
43	Game: 9	Daniel	John	Mary
44		David	Christopher
45		Jessica	Emily
46		Michael	Sarah
47
48	Game: 10	Sarah	Daniel	David
49		Michael	Mary
50		Jessica	Christopher
51		John	Emily
52
53	Game: 11	Christopher	Michael	Sarah
54		John	Jessica
55		Mary	Emily
56		David	Daniel
57
58	Game: 12	Mary	Daniel	Michael
59		John	Emily
60		David	Jessica
61		Christopher	Sarah
62
63	Game: 13	Michael	David	Emily
64		Jessica	Mary
65		Daniel	Sarah
66		Christopher	John
67
68	Game: 14	Jessica	John	Daniel
69		Sarah	Christopher
70		Mary	Michael
71		David	Emily
72
73	Game: 15	Emily	Christopher	Jessica
74		John	Daniel
75		David	Sarah
76		Mary	Michael
77
78
Sheet1

Option Explicit

Public Sub GenerateSchedule()

    Dim ws As Worksheet
    Dim ar As Variant, playerAr As Variant
    Dim i As Integer, x As Integer, rowStart As Integer, sitOutIndex As Integer
    Dim numGames As Variant, lastRow As Long
    Dim rng As Range

    Set ws = ThisWorkbook.Sheets("Sheet1") ' change to sheetname
    
    numGames = InputBox("Enter the number of games:", "Number of Games")
    
    If Not IsNumeric(numGames) Or numGames <= 0 Then
        MsgBox "Please enter a valid number for the number of games.", vbExclamation
        Exit Sub
    End If

    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    ReDim ar(0 To lastRow - 2)
    For i = 2 To lastRow
        ar(i - 2) = ws.Cells(i, "H").Value
    Next

    ws.Range("A:D").ClearContents
    rowStart = 3
    sitOutIndex = 0
    
    ws.Range("A1:D1").Value = Array("Game", "Court1", "Court2", "Sitting Out")
    
    For x = 0 To numGames - 1
        playerAr = ar
        sitOutIndex = GetSitOutIndex(ar, sitOutIndex)
        playerAr = RemoveElementFromArray(playerAr, sitOutIndex)
        playerAr = ShuffleArray(playerAr)
        
        For i = 0 To UBound(playerAr)

            If i = 0 Then
                ws.Cells(rowStart, 4).Value = ar(sitOutIndex)
                ws.Cells(rowStart, 1).Value = "Game: " & x + 1
            End If
            
            If i Mod 2 = 0 Then
                ws.Cells(rowStart, 2).Value = playerAr(i)
            Else
                ws.Cells(rowStart, 3).Value = playerAr(i)
                rowStart = rowStart + 1
            End If
        Next
        
        rowStart = rowStart + 1
    Next
End Sub

Function GetSitOutIndex(arr As Variant, currentIndex As Integer) As Integer
    If currentIndex + 1 = UBound(arr) Then
        GetSitOutIndex = 0
    Else
        GetSitOutIndex = currentIndex + 1
    End If
End Function

Function RemoveElementFromArray(arr As Variant, index As Integer) As Variant
    Dim i As Integer
    Dim newArr As Variant
    ReDim newArr(UBound(arr) - 1)
    
    For i = 0 To UBound(newArr)
        If i < index Then
            newArr(i) = arr(i)
        Else
            newArr(i) = arr(i + 1)
        End If
    Next
    RemoveElementFromArray = newArr
End Function

Function ShuffleArray(arr As Variant) As Variant
    Dim i As Integer
    Dim j As Integer
    Dim temp As Variant
    
    Randomize
    For i = UBound(arr) To LBound(arr) + 1 Step -1
        j = Int((i - 1 + 1) * Rnd + LBound(arr))
        temp = arr(j)
        arr(j) = arr(i)
        arr(i) = temp
    Next
    ShuffleArray = arr
End Function

 

[joeloveszoe]

try this

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	Game	Court1	Court2	Sitting Out				Players
2								John
3	Game: 1	Emily	Daniel	Mary				Mary
4		Christopher	Sarah					David
5		David	Michael					Sarah
6		John	Jessica					Michael
7								Emily
8	Game: 2	Jessica	Sarah	David				Daniel
9		John	Mary					Jessica
10		Daniel	Christopher					Christopher
11		Emily	Michael
12
13	Game: 3	Daniel	John	Sarah
14		Michael	Emily
15		Jessica	David
16		Christopher	Mary
17
18	Game: 4	Daniel	John	Michael
19		Christopher	David
20		Sarah	Emily
21		Mary	Jessica
22
23	Game: 5	Sarah	David	Emily
24		John	Christopher
25		Jessica	Mary
26		Daniel	Michael
27
28	Game: 6	Michael	David	Daniel
29		Jessica	Christopher
30		Sarah	John
31		Emily	Mary
32
33	Game: 7	David	Emily	Jessica
34		Mary	Daniel
35		John	Christopher
36		Michael	Sarah
37
38	Game: 8	Sarah	Emily	John
39		Jessica	David
40		Daniel	Christopher
41		Michael	Mary
42
43	Game: 9	Daniel	John	Mary
44		David	Christopher
45		Jessica	Emily
46		Michael	Sarah
47
48	Game: 10	Sarah	Daniel	David
49		Michael	Mary
50		Jessica	Christopher
51		John	Emily
52
53	Game: 11	Christopher	Michael	Sarah
54		John	Jessica
55		Mary	Emily
56		David	Daniel
57
58	Game: 12	Mary	Daniel	Michael
59		John	Emily
60		David	Jessica
61		Christopher	Sarah
62
63	Game: 13	Michael	David	Emily
64		Jessica	Mary
65		Daniel	Sarah
66		Christopher	John
67
68	Game: 14	Jessica	John	Daniel
69		Sarah	Christopher
70		Mary	Michael
71		David	Emily
72
73	Game: 15	Emily	Christopher	Jessica
74		John	Daniel
75		David	Sarah
76		Mary	Michael
77
78
Sheet1

Option Explicit

Public Sub GenerateSchedule()

    Dim ws As Worksheet
    Dim ar As Variant, playerAr As Variant
    Dim i As Integer, x As Integer, rowStart As Integer, sitOutIndex As Integer
    Dim numGames As Variant, lastRow As Long
    Dim rng As Range

    Set ws = ThisWorkbook.Sheets("Sheet1") ' change to sheetname
   
    numGames = InputBox("Enter the number of games:", "Number of Games")
   
    If Not IsNumeric(numGames) Or numGames <= 0 Then
        MsgBox "Please enter a valid number for the number of games.", vbExclamation
        Exit Sub
    End If

    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    ReDim ar(0 To lastRow - 2)
    For i = 2 To lastRow
        ar(i - 2) = ws.Cells(i, "H").Value
    Next

    ws.Range("A:D").ClearContents
    rowStart = 3
    sitOutIndex = 0
   
    ws.Range("A1:D1").Value = Array("Game", "Court1", "Court2", "Sitting Out")
   
    For x = 0 To numGames - 1
        playerAr = ar
        sitOutIndex = GetSitOutIndex(ar, sitOutIndex)
        playerAr = RemoveElementFromArray(playerAr, sitOutIndex)
        playerAr = ShuffleArray(playerAr)
       
        For i = 0 To UBound(playerAr)

            If i = 0 Then
                ws.Cells(rowStart, 4).Value = ar(sitOutIndex)
                ws.Cells(rowStart, 1).Value = "Game: " & x + 1
            End If
           
            If i Mod 2 = 0 Then
                ws.Cells(rowStart, 2).Value = playerAr(i)
            Else
                ws.Cells(rowStart, 3).Value = playerAr(i)
                rowStart = rowStart + 1
            End If
        Next
       
        rowStart = rowStart + 1
    Next
End Sub

Function GetSitOutIndex(arr As Variant, currentIndex As Integer) As Integer
    If currentIndex + 1 = UBound(arr) Then
        GetSitOutIndex = 0
    Else
        GetSitOutIndex = currentIndex + 1
    End If
End Function

Function RemoveElementFromArray(arr As Variant, index As Integer) As Variant
    Dim i As Integer
    Dim newArr As Variant
    ReDim newArr(UBound(arr) - 1)
   
    For i = 0 To UBound(newArr)
        If i < index Then
            newArr(i) = arr(i)
        Else
            newArr(i) = arr(i + 1)
        End If
    Next
    RemoveElementFromArray = newArr
End Function

Function ShuffleArray(arr As Variant) As Variant
    Dim i As Integer
    Dim j As Integer
    Dim temp As Variant
   
    Randomize
    For i = UBound(arr) To LBound(arr) + 1 Step -1
        j = Int((i - 1 + 1) * Rnd + LBound(arr))
        temp = arr(j)
        arr(j) = arr(i)
        arr(i) = temp
    Next
    ShuffleArray = arr
End Function

this looks very well thought out & creative thank you so much for your help!
sadly i will need a crash course on VBA s

happy friday to you!!!

 

[skillilea]

Glad it helped