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

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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

G
  • Solved
SUMIF for increases in row of data
Replies
5
Views
148
gopalgriffith
G
H
  • Question
League Scheduler
Replies
8
Views
284
Fluff
Fluff
K
  • Question
Array SUM or SUMPRODUCT function error
Replies
1
Views
226
KratosZG
K
P
  • Question
Import an Excel file while maintaining alignment with the user comment column
Replies
3
Views
312
Peter_SSs
Peter_SSs
I
  • Solved
Running Total In Column C Based On Date Change in Column B
Replies
3
Views
198
Fluff
Fluff

Forum statistics

Threads
1,214,645
Messages
6,120,711
Members
448,984
Latest member
foxpro

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