Jimmy
You can't meet all the conditions you specify. The condition that any 2
teams can meet no more than 2 times in the 40 matches is the primary driver.
Secondary to that is that all matches have no more than 4 teams. Mind
you, that says that all matches have no more than 4 teams, not that all
matches have 4 teams. Finally comes that each team races no more than 10
matches. Again, not 10 matches but no more than 10 matches.
This produces 33 matches with 4 teams, 6 matches with 3 teams, and one
match with 2 teams.
Seven teams race 10 times, 2 teams race 9 times, 6 teams race 8 times,
and 1 team races 7 times.
The macros that produce these numbers are shown below.
If you send me a good email address for you, I'll send you the file I built
to do this. My email address is (e-mail address removed). Remove the
"Cobia97 from this address. HTH Otto
Dim MatchRng As Range ' All 16 cells in each match
Dim TeamRng As Range 'The 16 teams in Column A
Dim i As Range 'Each team in TeamRng
Dim j As Range 'Each team in MatchRng
Dim ChkRngForDupPairs As Range
Dim c As Long 'Match counter
Dim d As Long 'Match counter for equivalent pairs
Dim e As Long 'Counter for equivalent pairs
Sub SetupTeams()
Set TeamRng = [A2:A17]
'Loop through all 40 matches
For c = 1 To 40
Set MatchRng = Range(Cells(2, c + 1), Cells(17, c + 1))
'Loop through all the teams
For Each i In TeamRng
If Application.CountIf(Range("B2:AO17"), i.Value) > 9 Then _
GoTo NextTeam
e = 0
'If team appears twice in same match, go to next team
If Application.CountIf(MatchRng, i.Value) > 1 Then GoTo NextTeam
'If # of teams in match >0 then chk for duplicate pairs in all
'matches, max is 2
If Application.CountA(MatchRng) > 0 Then
For Each j In MatchRng
If j.Value = "" Then GoTo NextjCell
For d = 1 To 40
Set ChkRngForDupPairs = Range(Cells(2, d + 1),
Cells(17, d + 1))
'MsgBox ChkRngForDupPairs.Address
If Not ChkRngForDupPairs.Find(i.Value) Is Nothing
Then _
If Not ChkRngForDupPairs.Find(j.Value) Is
Nothing Then _
e = e + 1
If e > 1 Then GoTo NextTeam
Next d
NextjCell:
Next j
End If
Cells(i.Row, c + 1).Value = i.Value
If Application.CountA(MatchRng) = 4 Then GoTo NextMatch
NextTeam:
Next i
NextMatch:
Next c
End Sub
