When you click the Go button, the program performs some setup work and then calls subroutine GenerateSolution.

Subroutine GenerateSolution checks to see whether the complete schedule is assigned and, if it is, calls subroutine CheckSchedule to examine the schedule. If the current schedule is not complete, then GenerateSolution picks two teams to play in the current round and then calls itself recursively to fill in later rounds. The code performs some basic checks to ensure that it doesn't pick two teams that have already played each other.

' Teams m_CurrentSchedule(r, 1) and
' m_CurrentSchedule(r, 2) play in round r.
Private m_CurrentSchedule() As Integer

Private m_BestScheduleValue As Double
Private m_BestSchedule() As Integer

Private m_ScheduleNum As Long
Private m_NumSchedules As Long
Private m_ScheduleMod As Long

Private Sub cmdGo_Click()
Const INFINITY As Double = 1E+300
Dim num_teams As Integer
Dim num_rounds As Integer
Dim txt As String
Dim r As Integer

    txtResults.Text = ""
    Screen.MousePointer = vbHourglass
    DoEvents

    ' Make room for the schedules.
    num_teams = CInt(txtNumTeams.Text)
    num_rounds = (num_teams * (num_teams - 1)) \ 2
    ReDim m_CurrentSchedule(1 To num_rounds, 1 To 2)
    ReDim m_BestSchedule(1 To num_rounds, 1 To 2)
    m_BestScheduleValue = -INFINITY

    ' Examine schedules.
    m_ScheduleNum = 0
    m_NumSchedules = Factorial(num_rounds)
    m_ScheduleMod = 10 ^ Int(Log(m_NumSchedules) / Log(10) _
        - 2)
    GenerateSchedule 1, num_teams, num_rounds

    ' Display the best schedule.
    txt = "Best Schedule (value " & m_BestScheduleValue & _
        ")" & vbCrLf
    For r = 1 To num_rounds
        txt = txt & "    " & m_BestSchedule(r, 1) & " v " & _
            m_BestSchedule(r, 2)
    Next r

    txtResults.Text = txt
    Screen.MousePointer = vbDefault
End Sub

' Pick teams for this round and examine the resulting
' schedule.
Private Sub GenerateSchedule(ByVal round As Integer, ByVal _
    num_teams As Integer, ByVal num_rounds As Integer)
Dim team1 As Integer
Dim team2 As Integer
Dim ok_match As Boolean
Dim r As Integer

    ' See if we have a full schedule.
    If round > num_rounds Then
        CheckSchedule num_teams, num_rounds
        Exit Sub
    End If

    For team1 = 1 To num_teams - 1
        For team2 = team1 + 1 To num_teams
            ' See if we can match team1 and team2.
            ok_match = True
            For r = 1 To round - 1
                ' Make sure this match hasn't already been
                ' played.
                If m_CurrentSchedule(r, 1) = team1 And _
                   m_CurrentSchedule(r, 2) = team2 _
                Then
                    ok_match = False
                    Exit For
                End If
            Next r

            ' Try matching team1 and team2.
            If ok_match Then
                m_CurrentSchedule(round, 1) = team1
                m_CurrentSchedule(round, 2) = team2

                GenerateSchedule round + 1, num_teams, _
                    num_rounds
            End If
        Next team2
    Next team1
End Sub

' See if the current solution is better than the best so
' far.
Private Sub CheckSchedule(ByVal num_teams As Integer, ByVal _
    num_rounds As Integer)
Dim current_value As Double
Dim r As Integer

    m_ScheduleNum = m_ScheduleNum + 1
    If m_ScheduleNum Mod m_ScheduleMod = 0 Then
        Me.Caption = m_ScheduleNum & "/" & m_NumSchedules
        Me.Refresh
    End If

    ' Get the current schedule's value.
    current_value = CurrentScheduleValue(num_teams, _
        num_rounds)

    ' See if this is an improvement.
    If m_BestScheduleValue < current_value Then
        m_BestScheduleValue = current_value
        For r = 1 To num_rounds
            m_BestSchedule(r, 1) = m_CurrentSchedule(r, 1)
            m_BestSchedule(r, 2) = m_CurrentSchedule(r, 2)
        Next r
    End If
End Sub

' Return the value of the current solution.
' The value is the sum of the squares of the differences
' between the team's
' values and their average. For example, if a team's value
' is 6 and the average
' is 4, the total value increases by (6-4)^2 = 2^2 = 4.
' Here low values are good because it means each team has
' about the same value.
Private Function CurrentScheduleValue(ByVal num_teams As _
    Integer, ByVal num_rounds As Integer) As Double
Dim team As Integer
Dim team_value() As Double
Dim total_value As Double
Dim ave_value As Double

    ' Make room for each team's value.
    ReDim team_value(1 To num_teams)

    ' Evaluate each team's value.
    total_value = 0
    For team = 1 To num_teams
        team_value(team) = TeamValue(team, num_teams, _
            num_rounds)
        total_value = total_value + team_value(team)
    Next team

    ' Combine the teams' values.
    ave_value = total_value / num_teams
    total_value = 0
    For team = 1 To num_teams
        total_value = total_value + (ave_value - _
            team_value(team)) ^ 2
    Next team

    ' Return a negative value so bigger values are better.
    CurrentScheduleValue = -total_value
End Function
Private Function Factorial(ByVal n As Integer) As Long
Dim result As Long
Dim i As Integer

    result = 1
    For i = 2 To n
        result = result * i
    Next i

    Factorial = result
End Function

This routine is the most confusing and the most important. It determines what the program think is important for picking a good schedule.

' Return the schedule's value to this team.
' The value is the sum of the squares of the differences
' between the team's
' lengths of rest and play runs and the ideal values. For
' example, if the
' ideal rest length is 2 games and the team has a rest of 4
' games, the
' value is (4-2)^2 = 2^2 = 4. Here low values are good.
Private Function TeamValue(ByVal team As Integer, ByVal _
    num_teams As Integer, ByVal num_rounds As Integer)
Dim num_played As Integer
Dim num_rested As Integer
Dim ideal_rest As Double
Dim ideal_play As Double
Dim cost_rest As Double
Dim cost_play As Double
Dim r As Integer
Dim was_playing As Boolean
Dim now_playing As Boolean
Dim current_run As Integer

    ' Every team plays (num_teams - 1) games.
    ' There are a total of num_rounds = (num_teams *
    ' (num_teams - 1))/2 games.
    ' Every team rests for num_rounds - num_played games.
    ' E.g. for 6 teams, every team plays 5 games, there are
    ' a total of 15 games, and each team rests for 10 games.
    ' The ideal rest schedule occurs when rests are spread
    ' equally between played games
    ' = num_rest_games / num_played
    num_played = num_teams - 1
    num_rested = num_rounds - num_played
    ideal_rest = num_rested / num_played

    ' Ideally we play 1 game in a row.
    ideal_play = 1

    ' Compare the team's play and rest streaks to the
    ' ideals.
    ' See if we rest or play in the first round.
    was_playing = _
        (m_CurrentSchedule(1, 1) = team) Or _
        (m_CurrentSchedule(1, 2) = team)

    ' Check other rounds.
    current_run = 1
    For r = 2 To num_rounds
        now_playing = _
            (m_CurrentSchedule(r, 1) = team) Or _
            (m_CurrentSchedule(r, 2) = team)

        ' See if we are starting or ending a rest.
        If now_playing = was_playing Then
            ' Continue the current streak.
            current_run = current_run + 1
        Else
            ' We are starting or ending a rest.
            If was_playing Then
                ' We were playing.
                cost_play = cost_play + (current_run - _
                    ideal_play) ^ 2
            Else
                ' We were resting.
                cost_rest = cost_rest + (current_run - _
                    ideal_rest) ^ 2
            End If

            current_run = 1
            was_playing = now_playing
        End If
    Next r

    ' Handle the final play or rest.
    If was_playing Then
        ' We were playing.
        cost_play = cost_play + Abs(current_run - _
            ideal_play) ^ 2
    Else
        ' We were resting.
        cost_rest = cost_rest + Abs(current_run - _
            ideal_rest) ^ 2
    End If

    ' Return the rest cost plus the play cost.
    TeamValue = cost_play + cost_rest
End Function