how to create a tennis team roaster 6 players and 32 tennis time slots

S

shripadjosh

New Member
Joined
Feb 22, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
hello - I need help to create team roaster.

We have 6 players and we play tennis once a week for 32 weeks.

We only need 4 players per week to play doubles.

How do I create roaster of 4 players using available 6 players for 32 weeks and still make sure there is equal rotation? I know some players may get to play more than others...

Appreciate any help!

Thanks,
Shri
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
Well, this is an equal rotation.

1614031584923.png


But do you want the same players playing each other or would you randomize it more?

The question isn't what you want to achieve but how you want to go about achieving it.
 
Upvote 0
thanks.

How do I randomize it more to make a non repeating combinations with 4 players?

Week 1
Player 1, 2 ,3 and 4

Week 2
Player 4, 5 ,6 and 1

Week 3
Player 2, 3 ,4 and 6
-----
-----
------
Week32
 
Upvote 0
Here is a way using VBA.

Tennis.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAH
1Player ListWk 1Wk 2Wk 3Wk 4Wk 5Wk 6Wk 7Wk 8Wk 9Wk 10Wk 11Wk 12Wk 13Wk 14Wk 15Wk 16Wk 17Wk 18Wk 19Wk 20Wk 21Wk 22Wk 23Wk 24Wk 25Wk 26Wk 27Wk 28Wk 29Wk 30Wk 31Wk 32
2Player 1XXXXXXXXXXXXXXXXXXXX
3Player 2XXXXXXXXXXXXXXXXXXXX
4Player 3XXXXXXXXXXXXXXXXXXXXX
5Player 4XXXXXXXXXXXXXXXXXXXXXX
6Player 5XXXXXXXXXXXXXXXXXXXX
7Player 6XXXXXXXXXXXXXXXXXXX
Sheet1


VBA Code: 
Sub TENNIS()
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim RES() As Variant: ReDim RES(1 To 6, 1 To 32)
Dim r As Integer

For wk = 1 To 32
    For PLY = 1 To 4
        If AL.Count = 0 Then fillAL AL
        r = AL.Item(Int((AL.Count) * Rnd()))
        AL.Remove r
        RES(r, wk) = "X"
    Next PLY
Next wk

Range("C2").Resize(UBound(RES), UBound(RES, 2)).Value = RES

End Sub

Sub fillAL(AL As Object)
AL.Clear
For i = 1 To 6
    AL.Add i
Next i
End Sub

And here is the distribution of the games.

Tennis.xlsm
CD
9Player ListCount
10Player 120
11Player 220
12Player 321
13Player 422
14Player 520
15Player 619
Sheet1
 
Upvote 0
Small code change.

Tennis.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAK
1Player ListWk 1Wk 2Wk 3Wk 4Wk 5Wk 6Wk 7Wk 8Wk 9Wk 10Wk 11Wk 12Wk 13Wk 14Wk 15Wk 16Wk 17Wk 18Wk 19Wk 20Wk 21Wk 22Wk 23Wk 24Wk 25Wk 26Wk 27Wk 28Wk 29Wk 30Wk 31Wk 32Player ListCount
2Player 1XXXXXXXXXXXXXXXXXXXXPlayer 120
3Player 2XXXXXXXXXXXXXXXXXXXXXPlayer 221
4Player 3XXXXXXXXXXXXXXXXXXXXXXPlayer 322
5Player 4XXXXXXXXXXXXXXXXXXXXXPlayer 421
6Player 5XXXXXXXXXXXXXXXXXXXXXXPlayer 522
7Player 6XXXXXXXXXXXXXXXXXXXXXXPlayer 622
Sheet1


VBA Code: 
Sub TENNIS()
Randomize
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim RES() As Variant: ReDim RES(1 To 6, 1 To 32)
Dim r As Integer, WK As Integer, PLY As Integer

For WK = 1 To 32
    For PLY = 1 To 4
        If AL.Count = 0 Then fillAL AL, RES, WK
        r = AL.Item(Int((AL.Count) * Rnd()))
        AL.Remove r
        RES(r, WK) = "X"
    Next PLY
Next WK

Range("C2").Resize(UBound(RES), UBound(RES, 2)).Value = RES

End Sub

Sub fillAL(AL As Object, RES() As Variant, WK As Integer)
AL.Clear
For i = 1 To 6
    If RES(i, WK) <> "X" Then AL.Add i
Next i
End Sub
 
Upvote 0
lrobbo314 said:
Small code change.

Tennis.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAK
1Player ListWk 1Wk 2Wk 3Wk 4Wk 5Wk 6Wk 7Wk 8Wk 9Wk 10Wk 11Wk 12Wk 13Wk 14Wk 15Wk 16Wk 17Wk 18Wk 19Wk 20Wk 21Wk 22Wk 23Wk 24Wk 25Wk 26Wk 27Wk 28Wk 29Wk 30Wk 31Wk 32Player ListCount
2Player 1XXXXXXXXXXXXXXXXXXXXPlayer 120
3Player 2XXXXXXXXXXXXXXXXXXXXXPlayer 221
4Player 3XXXXXXXXXXXXXXXXXXXXXXPlayer 322
5Player 4XXXXXXXXXXXXXXXXXXXXXPlayer 421
6Player 5XXXXXXXXXXXXXXXXXXXXXXPlayer 522
7Player 6XXXXXXXXXXXXXXXXXXXXXXPlayer 622
Sheet1


VBA Code: 
Sub TENNIS()
Randomize
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim RES() As Variant: ReDim RES(1 To 6, 1 To 32)
Dim r As Integer, WK As Integer, PLY As Integer

For WK = 1 To 32
    For PLY = 1 To 4
        If AL.Count = 0 Then fillAL AL, RES, WK
        r = AL.Item(Int((AL.Count) * Rnd()))
        AL.Remove r
        RES(r, WK) = "X"
    Next PLY
Next WK

Range("C2").Resize(UBound(RES), UBound(RES, 2)).Value = RES

End Sub

Sub fillAL(AL As Object, RES() As Variant, WK As Integer)
AL.Clear
For i = 1 To 6
    If RES(i, WK) <> "X" Then AL.Add i
Next i
End Sub
Click to expand...
Thank you so much! Is it possible to attach the xlsm file? Thanks again!
 
Upvote 0
I'm not able to use file sharing web sites. You can just copy the code and insert it into a new module.

Go to the VBA editor by hitting Alt+F11.
Click 'Insert', click 'Module, then paste the code.

This updated version of the code gives a better and more consistent result.

Tennis.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAI
1Player ListWk 1Wk 2Wk 3Wk 4Wk 5Wk 6Wk 7Wk 8Wk 9Wk 10Wk 11Wk 12Wk 13Wk 14Wk 15Wk 16Wk 17Wk 18Wk 19Wk 20Wk 21Wk 22Wk 23Wk 24Wk 25Wk 26Wk 27Wk 28Wk 29Wk 30Wk 31Wk 32Total
2Player 1XXXXXXXXXXXXXXXXXXXXX21
3Player 2XXXXXXXXXXXXXXXXXXXXXX22
4Player 3XXXXXXXXXXXXXXXXXXXXX21
5Player 4XXXXXXXXXXXXXXXXXXXXX21
6Player 5XXXXXXXXXXXXXXXXXXXXXX22
7Player 6XXXXXXXXXXXXXXXXXXXXX21
Sheet1
Cell Formulas
RangeFormula
AI2:AI7AI2=COUNTA(C2:AH2)


VBA Code: 
Sub TENNIS()
Randomize
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim RES() As Variant: ReDim RES(1 To 6, 1 To 32)
Dim r As Integer

For WK = 1 To 32
    If AL.Count = 0 Then fillAL AL
    r = Int((AL.Count) * Rnd())
    v = AL(r)
    AL.removeAt r
    For Each i In v
        RES(i, WK) = "X"
    Next i
Next WK

Range("C2").Resize(UBound(RES), UBound(RES, 2)).Value = RES

End Sub

Sub fillAL(AL As Object)
AL.Add Array(1, 2, 3, 4)
AL.Add Array(2, 3, 4, 5)
AL.Add Array(3, 4, 5, 6)
AL.Add Array(1, 2, 3, 6)
AL.Add Array(2, 3, 4, 6)
AL.Add Array(1, 3, 4, 5)
AL.Add Array(1, 4, 5, 6)
AL.Add Array(1, 2, 4, 5)
AL.Add Array(2, 3, 5, 6)
AL.Add Array(1, 3, 4, 6)
AL.Add Array(1, 3, 5, 6)
AL.Add Array(1, 2, 4, 6)
AL.Add Array(1, 2, 5, 6)
AL.Add Array(1, 2, 3, 5)
AL.Add Array(2, 4, 5, 6)
End Sub
 
Upvote 0
lrobbo314 said:
I'm not able to use file sharing web sites. You can just copy the code and insert it into a new module.

Go to the VBA editor by hitting Alt+F11.
Click 'Insert', click 'Module, then paste the code.

This updated version of the code gives a better and more consistent result.

Tennis.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAI
1Player ListWk 1Wk 2Wk 3Wk 4Wk 5Wk 6Wk 7Wk 8Wk 9Wk 10Wk 11Wk 12Wk 13Wk 14Wk 15Wk 16Wk 17Wk 18Wk 19Wk 20Wk 21Wk 22Wk 23Wk 24Wk 25Wk 26Wk 27Wk 28Wk 29Wk 30Wk 31Wk 32Total
2Player 1XXXXXXXXXXXXXXXXXXXXX21
3Player 2XXXXXXXXXXXXXXXXXXXXXX22
4Player 3XXXXXXXXXXXXXXXXXXXXX21
5Player 4XXXXXXXXXXXXXXXXXXXXX21
6Player 5XXXXXXXXXXXXXXXXXXXXXX22
7Player 6XXXXXXXXXXXXXXXXXXXXX21
Sheet1
Cell Formulas
RangeFormula
AI2:AI7AI2=COUNTA(C2:AH2)


VBA Code: 
Sub TENNIS()
Randomize
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim RES() As Variant: ReDim RES(1 To 6, 1 To 32)
Dim r As Integer

For WK = 1 To 32
    If AL.Count = 0 Then fillAL AL
    r = Int((AL.Count) * Rnd())
    v = AL(r)
    AL.removeAt r
    For Each i In v
        RES(i, WK) = "X"
    Next i
Next WK

Range("C2").Resize(UBound(RES), UBound(RES, 2)).Value = RES

End Sub

Sub fillAL(AL As Object)
AL.Add Array(1, 2, 3, 4)
AL.Add Array(2, 3, 4, 5)
AL.Add Array(3, 4, 5, 6)
AL.Add Array(1, 2, 3, 6)
AL.Add Array(2, 3, 4, 6)
AL.Add Array(1, 3, 4, 5)
AL.Add Array(1, 4, 5, 6)
AL.Add Array(1, 2, 4, 5)
AL.Add Array(2, 3, 5, 6)
AL.Add Array(1, 3, 4, 6)
AL.Add Array(1, 3, 5, 6)
AL.Add Array(1, 2, 4, 6)
AL.Add Array(1, 2, 5, 6)
AL.Add Array(1, 2, 3, 5)
AL.Add Array(2, 4, 5, 6)
End Sub
Click to expand...
Thanks again!
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Soccer League Workbook
Replies
1
Views
191
hagia_sofia
hagia_sofia
I
  • Solved
Generate list of players for four school teams
2
Replies
16
Views
863
imcl75
I
JenniferMurphy
  • Question Question
How to tally tennis court pairings?
Replies
9
Views
668
JenniferMurphy
JenniferMurphy
K
  • Question Question
Calculating player win-loss records
Replies
1
Views
1K
KWD
K
S
  • Question Question
analyze and export based on multiple criteria
Replies
0
Views
526
slash32487
S

Forum statistics

Threads
1,223,576
Messages
6,173,153
Members
452,503
Latest member
AM74

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top