Random Team Scheduler Over Multiple Weeks

F

foxhound

Board Regular
Joined
Mar 21, 2003
Messages
182
<body>
<p>Hi All,</p><p>I need help trying to make a team scheduler for a non-profit league using XL2003/7. I need to pick random opponents over an 8 week period for each team with no team playing each other more than once, and only playing one game each week. The number of teams can vary year-to-year, so if that can be dynamic, even better! Below is the layout I'm hoping to achieve. Any help would be greatly and sincerely appreciated! :)</p>
<p></p>
<table border="1"; style="width:500px">
<tr>
<th>Team ID</th>
<th>Week 1</th>
<th>Week 2</th>
<th>Week 3</th>
<th>Week 4</th>
<th>Week 5</th>
<th>Week 6</th>
<th>Week 7</th>
<th>Week 8</th>
</tr>
<tr>
<td>100</td>
<td>650</td>
<td>600</td>
<td>550</td>
<td>500</td>
<td>450</td>
<td>400</td>
<td>350</td>
<td>300</td>
</tr>
<tr>
<td>150</td>
<td>600</td>
<td>500</td>
<td>400</td>
<td>300</td>
<td>200</td>
<td>650</td>
<td>550</td>
<td>450</td>
</tr>
<tr>
<td>200</td>
<td>550</td>
<td>450</td>
<td>350</td>
<td>250</td>
<td>150</td>
<td>600</td>
<td>500</td>
<td>400</td>
</tr>
<tr>
<td>250</td>
<td>500</td>
<td>400</td>
<td>300</td>
<td>200</td>
<td>650</td>
<td>550</td>
<td>450</td>
<td>350</td>
</tr>
<tr>
<td>300</td>
<td>450</td>
<td>350</td>
<td>250</td>
<td>150</td>
<td>600</td>
<td>500</td>
<td>400</td>
<td>100</td>
</tr>
<tr>
<td>350</td>
<td>400</td>
<td>300</td>
<td>200</td>
<td>650</td>
<td>550</td>
<td>450</td>
<td>100</td>
<td>250</td>
</tr>
<tr>
<td>400</td>
<td>350</td>
<td>250</td>
<td>150</td>
<td>600</td>
<td>500</td>
<td>100</td>
<td>300</td>
<td>200</td>
</tr>
<tr>
<td>450</td>
<td>300</td>
<td>200</td>
<td>650</td>
<td>550</td>
<td>100</td>
<td>350</td>
<td>250</td>
<td>150</td>
</tr>
</table>
</body>
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Okay... I've been working with this, and the below gets me close. However, it seems to get caught in a loop and I can't figure out why yet.

Sub CreateLeagueSchedule()
Dim wk As Integer
Dim rngWeek As Range
Dim rngTeamSched As Range
Dim lngRndTeam As Long
Dim lngTeam As Long
Dim lngNumWeeks As Long
Dim MaxTries As Long

On Error GoTo Err_CreateLeagueSchedule

lngTeam = 1 + Range("tTEAMID").Rows.Count
lngNumWeeks = 8 + 1 'Add one to account for TeamID column

For wk = 2 To lngNumWeeks
Set rngWeek = Range(Cells(2, wk), Cells(lngTeam, wk))

MaxReachedReTry:
Range(Cells(2, wk), Cells(lngTeam, wk)).ClearContents
For Each c In rngWeek
Set rngTeamSched = Nothing
Set rngTeamSched = Range(Cells(c.row, 1), Cells(c.row, lngNumWeeks))

MaxTries = 0
TeamScheduled:
If MaxTries > lngTeam Then GoTo MaxReachedReTry
lngRndTeam = GetNewTeam
If CheckTeam(rngWeek, lngRndTeam, rngTeamSched) = False Then
c.Value = lngRndTeam
Else
MaxTries = MaxTries + 1
GoTo TeamScheduled
End If
Next c
Next wk

Exit Sub

Err_CreateLeagueSchedule:
MsgBox Err.Description
Set rngTeamSched = Nothing
Set rngWeek = Nothing
' Resume Next
Exit Sub

End Sub

Function GetNewTeam()
Dim e
Static myList As Object
If myList Is Nothing Then
Set myList = CreateObject("System.Collections.SortedList")
End If
If myList.Count = 0 Then
Randomize
For Each e In Range("tTEAMID").Value
myList.Item(Rnd) = e
Next
End If
GetNewTeam = myList.GetByIndex(0)
myList.RemoveAt 0
End Function

Function CheckTeam(rngWeek As Range, lngRndTeam As Long, rngTeamSched As Range)
Dim result As String
If (WorksheetFunction.CountIf(rngWeek, lngRndTeam)) + (WorksheetFunction.CountIf(rngTeamSched, lngRndTeam)) = 0 Then
result = "False"
Else: result = "True"
End If
CheckTeam = result
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Latest Data pull-up from the corresponding date
Replies
8
Views
192
RobP
R
S
  • Question Question
Latest Data Pull-up from the corresponding date-Single party
Replies
3
Views
124
Sergius
S
J
  • Solved
Sumifs - Using Multiple Criteria and Multiple Values
Replies
7
Views
307
NickFru
N
T
  • Solved
Excel formula: how to sum multiple columns on a single criteria
Replies
3
Views
306
TT123
T
G
  • Solved
SUMIF for increases in row of data
Replies
5
Views
346
gopalgriffith
G

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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