looping code with if's

i have a spreadsheet with some code behind it to generate a set of fixtures for a football/soccer league.

I have a few issues with it though that i need some help with....and with the new season coming up i need help fast...

The code does what it should to a point..

If the team count in a division is equal it generates a full set of fixtures that are required...

If the team count in a division is odd it will create a fixture called crazy punks this will be a free week in effect. (not sure where or how this is done) but it does what i need it to.

where i am struggling is in 2 places.

firstly

if you look at round 1 in the Required Matches worksheet

4 fixtures are scheduled for the same venue this can't happen as one venue can only host one fixture per round.

Secondly

also i would like to split the fixtures about a bit so that teams don't play each other back to back.

you will notice that all teams play each other back to back...i need to prevent this.

... any ideas please.

below is the code behind my worksheet

Code:

---

Option Explicit
Sub GenFixtures()
    ' Using worksheet functions quite a bit
    Dim wsf As WorksheetFunction
    Set wsf = Application.WorksheetFunction
   
    Dim mH As Range, mA As Range, mV As Range, mD As Range, mR As Range
    Dim tT As Range, tD As Range, tV As Range
    ' Get all our named columns
    With ThisWorkbook
        ' Should check for screwed up names here
        Set tT = .Names("TITeam").RefersToRange
        Set tD = .Names("TIDivision").RefersToRange
        Set tV = .Names("TIVenue").RefersToRange
        Set mH = .Names("RMHome").RefersToRange
        Set mA = .Names("RMAway").RefersToRange
        Set mV = .Names("RMVenue").RefersToRange
        Set mD = .Names("RMDivision").RefersToRange
        Set mR = .Names("RMRound").RefersToRange
    End With
    'If wsf.CountA(mH) > 0 Or wsf.CountA(mA) > 0 Or wsf.CountA(mV) > 0 Or wsf.CountA(mD) > 0 Or wsf.CountA(mR) > 0 Then
    '    Err.Raise 501, , "Required matches is not empty!"
    'End If
    mH.Clear: mA.Clear: mV.Clear: mD.Clear: mR.Clear
    ' Match offset, a row offset into the m ranges
    Dim moff As Integer
    moff = 1
    Dim div As Integer
    ' Step through each division
    For div = wsf.Min(tD) To wsf.Max(tD)
        Dim nc As Integer ' Number of competitors
        nc = wsf.CountIf(tD, "=" & div)
        If nc > 1 Then ' Make sure there are at least two teams in this divison!
            ' Storing the teams as row offsets
            ' If odd, nc Mod 2 will be one, this adds our dummy competitor.
            ReDim teamOff(1 To nc + nc Mod 2) As Integer
            Dim row As Long, comp As Integer
            comp = 1
            For row = 1 To tD.Rows.Count
                If tD.Rows(row).Value = div Then
                    teamOff(comp) = row
                    comp = comp + 1
                    If comp > nc Then
                        ' Don't need to scan the whole 65k cell range.
                        Exit For
                    End If
                End If
            Next row
            If comp <> nc + 1 Then Err.Raise 503, , "CountIf function didn't agree with scanning worksheet"
            If nc Mod 2 = 1 Then ' Number of competitors is odd
                teamOff(nc + 1) = -1 ' Add the dummy competitor
                nc = nc + 1
            End If
            Dim round As Integer, game As Integer
            ' These loops are 0 based to simplify modulus arithmetic
            For round = 0 To nc - 2
                Dim home As Integer
                Dim away As Integer
                For game = 0 To nc / 2 - 1
                    ' This isn't exactly a clockwise rotation but it will get everyone.
                    If game = 0 Then
                        home = 1
                    Else
                        home = (round + game + nc - 2) Mod (nc - 1) + 2
                    End If
                    away = (round + (nc / 2 - 1 - game) + nc - 2 + nc / 2) Mod (nc - 1) + 2
                    ' Don't play a dummy competitor
                    If teamOff(home) <> -1 And teamOff(away) <> -1 Then
                        home = teamOff(home)
                        away = teamOff(away)
                        mH.Rows(moff).Value = tT.Rows(home).Value
                        mA.Rows(moff).Value = tT.Rows(away).Value
                        mV.Rows(moff).Value = tV.Rows(home).Value
                        mD.Rows(moff).Value = tD.Rows(home).Value
                        mR.Rows(moff).Value = round * 2 + 1
                        moff = moff + 1
                    End If
                Next game
                ' Since it's a double round robin, we just add in the same
                ' rounds with home and away swapped.
                For game = 0 To nc / 2 - 1
                    ' This isn't exactly a clockwise rotation but it will get everyone.
                    If game = 0 Then
                        away = 1
                    Else
                        away = (round + game + nc - 2) Mod (nc - 1) + 2
                    End If
                    home = (round + (nc / 2 - 1 - game) + nc - 2 + nc / 2) Mod (nc - 1) + 2
                    ' Don't play a dummy competitor
                    If teamOff(home) <> -1 And teamOff(away) <> -1 Then
                        home = teamOff(home)
                        away = teamOff(away)
                        mH.Rows(moff).Value = tT.Rows(home).Value
                        mA.Rows(moff).Value = tT.Rows(away).Value
                        mV.Rows(moff).Value = tV.Rows(home).Value
                        mD.Rows(moff).Value = tD.Rows(home).Value
                        mR.Rows(moff).Value = round * 2 + 2 ' Round value incremented
                        moff = moff + 1
                    End If
                Next game
            Next round
        End If
    Next div
End Sub

---