Double Elimination Sports Tournament Bracket

I'm part of a rec league softball team that plays in a league with an end-of-season tournament. Before the tournament, the league organizers send out the tournament bracket, in Word format. I personally feel that the Word document is ugly, and the way the organizers set it up, it's not always easy to read. (This year's version of the bracket spans 4 pages!) I want to try and format the bracket in Excel, and have a series of macros to "advance" the winners by double clicking on the team name.

The problem is that it's a double elimination tournament. So, really, there are 2 brackets, the Winners Bracket, and the Loser's bracket. To start with, every team is in the Winner's bracket. If they win, they stay in that bracket. But, if they lose, they get sent to the Loser's bracket. (Once you're in the Loser's bracket, if you lose, you're done)

I can make a decent looking bracket reasonably easily, and I even have some code that will advance the winners along the lines of the bracket. The trouble I'm running into is finding an easy way to move the team names of the losers into the Loser's bracket. I know that I can setup code for each game that is basically an if-then statement ... If I click on Team1, then they advance and Team2's name goes to the appropriate cell on the loser's bracket ... but that's a very manual solution, and not terribly re-usable from one year to the next (the # of teams/games is not always consistent)

Here is the code that I'm using that will advance the team along the bracket lines. This code is working, and works well for a single-elimination tournament.

I've also attached the spreadsheet that I've created for this year's tournament. Each game is numbered, G1, G2, etc ... so, "Loser G3" would be the loser of Game #3. The winners bracket is represented with green highlights, red for the losers bracket.

Any advice would be greatly appreciated.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True

    Dim row As Integer
    Dim col As Integer
    
    Dim Direction As Integer
    Dim reachedTop As Boolean
    Dim reachedBottom As Boolean
    Dim Border
    
    Dim GoodCell
    Set GoodCell = Nothing
    
    row = Target.row
    col = Target.Column
    
    With ActiveSheet:
        If col <= 7 Then
            Border = xlEdgeLeft
            col = col + 1
        ElseIf col >= 7 Then
            Border = xlEdgeRight
            col = col - 1
        Else
            Exit Sub
        End If
    
        If .Cells(row, col).Borders(Border).LineStyle = xlNone Then
            reachedTop = True
            Direction = 1
            row = row + Direction
        Else
            Direction = -1
        End If
        
        Do
            If .Cells(row, col).Borders(Border).LineStyle = xlNone Then
                If Direction > 0 Then
                    reachedBottom = True
                    Direction = -1
                Else
                    reachedTop = True
                    Direction = 1
                End If
            End If
            
            If .Cells(row, col).Borders(xlEdgeBottom).LineStyle <> xlNone Then
                Set GoodCell = .Cells(row, col)
                Exit Do
            End If
        
            If reachedTop And reachedBottom Then Exit Do
            
            row = row + Direction
        Loop While True
        
    End With
    
    If GoodCell Is Nothing Then
        MsgBox "Invalid Entry"
    Else
        GoodCell.Value = Target.Value
    End If
    
End Sub

Hi Wolverine (Eric?),

Suggestions...
First I'd make all your bracket spacing the same for the winners bracket. That is, in Column E the winner from the top moves down 3 rows but the winner from the bottom moves up 5 rows. You should have the rows moved the same for the top or bottom winner in the main bracket. Then your code could look at the Column() number and know how far to move.

Second - I'd put the Date, Time, Field, Game Number all on the same row, just to the left of the winner. Then I'd key on the last 3 characters (G10, G21, etc) to do a search of the losers bracket to find a place for the loser. This would also mean you need to make the Game numbers all 3 characters (G01, G02,.. G09, G10).

I think this would then allow you to standardize you data and code.

If you don't understand then bump this and I can write some code. But first move the winners in the E column down (Game 43 and Game 45 and Game 61) so they are in the middle. Also put the Game numbers on the same row as the winner and one column to the left.

Try this version - also in the attached.

Attachment 317316

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True

    Dim row As Integer
    Dim col As Integer
    Dim strLoser As String
    Dim rngLoser As Range
    Dim rngGame As Range
    Dim rngNextGame As Range
    Dim rngTitle As Range
    
    row = Target.row
    col = Target.Column + IIf(Target.Column < 7, 1, -1)
    
    If Cells(1, Target.Column).Value > Target.row Then
        Set rngGame = Target.Resize(Cells(1, Target.Column).Value)
        strLoser = rngGame.Cells(rngGame.Cells.Count).Value
        GoTo GotGame
    End If
    If Application.CountA(Target.Resize(Cells(1, Target.Column).Value)) < Application.CountA(Target.Offset(1 - Cells(1, Target.Column).Value).Resize(Cells(1, Target.Column).Value)) Then
        Set rngGame = Target.Offset(1 - Cells(1, Target.Column).Value).Resize(Cells(1, Target.Column).Value)
        strLoser = rngGame.Cells(1).Value
    Else
        Set rngGame = Target.Resize(Cells(1, Target.Column).Value)
        strLoser = rngGame.Cells(rngGame.Cells.Count).Value
    End If
    
GotGame:

    If strLoser = "" Then
        MsgBox "That team had no opponent"
        Exit Sub
    End If

    Set rngNextGame = NGame(rngGame, col)
    
    If rngNextGame Is Nothing Then
        MsgBox "Oh-oh - check your color fill for the next game"
        Exit Sub
    End If
    
    Application.EnableEvents = False
    
    If col < Target.Column Then
         rngNextGame.Value = Target.Value
         GoTo ResetEvents
    End If

    If rngNextGame.Value <> "" Then
        If MsgBox("This game has already been entered. Change the winner?", vbYesNo) = vbNo Then GoTo ResetEvents
        rngNextGame.Value = Target.Value
        Set rngLoser = Range("G:P").Find(Target.Value, Range("G1"), xlValues, xlWhole)
        rngLoser.Value = strLoser
    Else
        rngNextGame.Value = Target.Value
        Set rngTitle = rngGame.Resize(rngGame.Cells.Count - 2).Offset(1).Find("* G*")
        Set rngLoser = Range("G:P").Find(Application.Trim("Loser " & Mid(rngTitle.Value, InStrRev(rngTitle.Value, " G"))), Range("G1"), xlValues, xlWhole)
        If rngLoser Is Nothing Then
              MsgBox Application.Trim("Loser " & Mid(rngTitle.Value, InStrRev(rngTitle.Value, " G"))) & "  is missing"
        End If
        rngLoser.Value = strLoser
    End If
ResetEvents:
    Application.EnableEvents = True
     
End Sub

Function NGame(r1 As Range, c1 As Integer) As Range
    Dim r As Range
    For Each r In r1
        If Cells(r.row, c1).Interior.ColorIndex = r1.Cells(1).Interior.ColorIndex Then
            Set NGame = Cells(r.row, c1)
            Exit Function
        End If
    Next r
End Function

I should have said that my solution requires two new rows at the top, with opponent spacing values in row 1...