Hi all,

Be prepared ! This is the time of yesr when requests for code to prepare
League Fixtures start floating around. The code below does just that. To
use, copy the code to a standard module, select a blank worksheet, enter the
number of teams in "A1" and then run.
Columns show the matches for each fixture by numbers e.g. Team 1 v Team 4.
For a different number of teams enter a new value in "A1". Two teams using
the same venue can be paired using any of the Home/Away numbers shown below
the fixtures. Should anyone be interested in a full App. which uses actual
names and dates, neatly prints out the fixtures, keeps a record of the
results of matches played and maintains an up-to-dte League Table, then
please contact me direct.

Regards,
Don.

Sub Fixtures()
Dim Draw() As Integer, Vnu() As Integer
Dim T, F, C, x, y, V, DestRw, DRw2, Mtch
T = Int(Cells(1, 1))
If T Mod 2 0 Then T = T + 1
F = T - 1
ReDim Draw(T, F)
ReDim Vnu(T, F)
Cells.Clear
C = 4 ' DRAW
For x = 1 To F: For y = 1 To T - 1
If y 1 Then C = C + 1
If C F Then C = 1
Draw(x, y) = C
If C = x Then
Draw(T, y) = C: Draw(x, y) = T
End If
Next y, x
V = 1 ' VENUES
For x = 1 To T / 2: For y = 1 To F
If V = 1 Then Vnu(x, y) = V
If Draw(x, y) < T And y < F Then V = V * -1
Next y
V = V * -1
Next x
For x = 1 To T / 2: For y = 1 To F
If Vnu(x, y) = 0 Then Vnu(x + T / 2, y) = 1
Next y, x
Application.ScreenUpdating = False
DestRw = 2 ' PRINT to SCREEN
For x = 1 To F: For y = 1 To T
If Vnu(y, x) = 1 Then
Mtch = y & " v " & Draw(y, x)
Cells(DestRw, x) = Mtch
Mtch = Draw(y, x) & " v " & y
DRw2 = Int(DestRw + 2 + F / 2)
Cells(DRw2, x) = Mtch
DestRw = DestRw + 1
End If
Next
DestRw = 2
Next
Cells.Columns.AutoFit
Cells(1, 1) = T
Cells(1, 2) = "Teams - 1st Half Fixtures."
Cells(T / 2 + 2, 2) = "2nd Half -Venues reversed."
Cells(T + 4, 2) = "Home/Away Teams"
DestRw = T + 5
For x = 1 To T / 2
Mtch = x & " & " & x + T / 2
Cells(DestRw, 2) = Mtch
DestRw = DestRw + 1
Next
End Sub