Golf Outing - create matchups without duplicates

D

dmarek

New Member
Joined
Mar 26, 2010
Messages
23
Hi, I'm helping my friend try to create a weekend golf outing where we have seeds and we want to pair people up attempting to not let people play twice. So for Rnd 2 who to play I was trying to create a minifs formula but then I realized I'm getting duplicates. How do I check the values above to see if they are not reused and get the next smallest, and then move over to future columns and rounds.

More context, rounds 1 and 2 are teams (scramble, alternate shot) rounds 3 and 4 are one versus one (match, stroke). First round is already setup so looking to figure out rounds 2-4.

=MINIFS($B:$B, $A:$A, "<>"&$A3, $B:$B, "<>"&$E3, $B:$B, "<>"&$F3)


Rd1Rd2Rd3Rd4
TeamNumberLookupNameNbr Played 1Nbr Played 2Nbr Played 3Nbr Played 4
A1A1Reed111213
A2A2Gib111213
A3A3Dan131411
A4A4TK131411
A5A5Colbert151611
A6A6Daniel151611
A7A7Josh C171811
A8A8Thomas171811
A9A9Travis192011
A10A10Matt192011
B11B11Sam123
B12B12Jordan123
B13B13JP341
B14B14Joey341
B15B15Josh B561
B16B16Cole561
B17B17Kyle781
B18B18Jeff781
B19B19BC9101
B20B20Other9101
 
Sort by date Sort by votes
This is known as the Social Golfer problem, and it's pretty hard to solve. There are some complicated algorithms. If you do a search of this forum (use the button in the upper right), you'll find a wide variety of suggestions, from formulas to VBA. But truly, for a one time thing, or even sporadic, it's easier to use a dedicated web site. Check this out:

 
Upvote 0
I believe you are seeking a ROUND ROBIN scenario :

VBA Code: 
Option Explicit


Sub RoundRobin()
Dim ToTGames As Integer, ColCnt As Integer, Rng As Range, LastCol As Integer, Icntr As Integer
Dim Lastrow As Integer, Cnt As Integer, ColNum As Integer, Counter As Integer
Dim FirstRow As Integer, SecondRow As Integer, Games As Integer

ToTGames = Application.InputBox("Enter number of Round Robin games.", Type:=1, _
                                  Title:="ROUND ROBIN GAMES ENTRY")
If ToTGames = 0 Then
    MsgBox "No Round Robin games entered!"
    Exit Sub
End If

Randomize

With Sheets("sheet1")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With

For Icntr = LastCol To 4 Step -1
    Columns(Icntr).EntireColumn.ClearContents
Next

Sheets("sheet1").Range("C" & 1) = "NAMES"
Sheets("sheet1").Range("A1:A" & Lastrow).Copy Destination:=Sheets("sheet1").Range("C" & 2)
Application.CutCopyMode = False

If Lastrow Mod 2 <> 0 Then
    MsgBox "Some one's not playing!"
End If

ColNum = 4
Games = 0

StartAgain:

Cnt = 0

Do

abovefirstrow:

    If Cnt > 1000 Then
        Sheets("sheet1").Range("B1:B" & Lastrow).ClearContents
        Games = Games + 1
            If Games = ToTGames Then
                Exit Sub
            Else
                Counter = 0
                ColNum = ColNum + 1
                GoTo StartAgain
            End If
    End If
    
    FirstRow = Int((Lastrow * Rnd) + 1)
    
    If Sheets("sheet1").Range("B" & FirstRow).Value <> vbNullString Then
        Cnt = Cnt + 1
        GoTo abovefirstrow
    End If
    
abovesecondrow:

    SecondRow = Int((Lastrow * Rnd) + 1)
    
    If Sheets("sheet1").Range("B" & SecondRow).Value <> vbNullString Then
        GoTo abovesecondrow
    End If
    
    If FirstRow = SecondRow Then
        Cnt = Cnt + 1
        GoTo abovefirstrow
    End If
    
    If Sheets("sheet1").Range("A" & FirstRow).Value = _
        Sheets("sheet1").Range("A" & SecondRow).Value Then
        Cnt = Cnt + 1
        GoTo abovefirstrow
    End If
    
    If ColNum > 4 Then
        For ColCnt = 4 To ColNum
            If Sheets("sheet1").Range("A" & SecondRow).Value = Sheets("sheet1").Cells(FirstRow + 1, ColCnt).Value Or _
                Sheets("sheet1").Range("A" & FirstRow).Value = Sheets("sheet1").Cells(SecondRow + 1, ColCnt).Value Then
                Cnt = Cnt + 1
                GoTo abovefirstrow
            End If
        Next ColCnt
    End If
    
    Sheets("sheet1").Cells(1, ColNum).Value = "GAME " & ColNum - 3
    Sheets("sheet1").Cells(FirstRow + 1, ColNum).Value = Sheets("sheet1").Range("A" & SecondRow).Value
    Sheets("sheet1").Cells(SecondRow + 1, ColNum).Value = Sheets("sheet1").Range("A" & FirstRow).Value
    Sheets("sheet1").Range("B" & FirstRow).Value = "Done"
    Sheets("sheet1").Range("B" & SecondRow).Value = "Done"
    Counter = Counter + 1
    
    If Counter = Lastrow Then
        Sheets("sheet1").Range("B1:B" & Lastrow).ClearContents
        Games = Games + 1
        If Games = ToTGames Then
            Exit Sub
        Else
            Counter = 0
            ColNum = ColNum + 1
            GoTo StartAgain
        End If
    End If
Loop

End Sub


Sub clrData()
    Sheet1.Range("C1:AZ500").Value = ""
End Sub

Download example workbook : Internxt Drive – Private & Secure Cloud Storage

Click the CommandButton on the worksheet ... enter how many games.
 
Upvote 0
Eric W said:
This is known as the Social Golfer problem, and it's pretty hard to solve. There are some complicated algorithms. If you do a search of this forum (use the button in the upper right), you'll find a wide variety of suggestions, from formulas to VBA. But truly, for a one time thing, or even sporadic, it's easier to use a dedicated web site. Check this out:

Click to expand...
Love the idea, but I'm not sure this has the variability we were looking for. Or I don't quite see how to setup team A and team B so more than 2 get put together.
 
Upvote 0
Here is another project that allows the grouping of pairs, three's, four's, five's.

VBA Code: 
Option Explicit


Sub RoundRobin()
Dim ToTGames As Integer, ColCnt As Integer, Rng As Range, LastCol As Integer, Icntr As Integer
Dim Lastrow As Integer, Cnt As Integer, ColNum As Integer, Counter As Integer
Dim FirstRow As Integer, SecondRow As Integer, Games As Integer

ToTGames = Application.InputBox("Enter number of Round Robin games.", Type:=1, _
                                  Title:="ROUND ROBIN GAMES ENTRY")
If ToTGames = 0 Then
    MsgBox "No Round Robin games entered!"
    Exit Sub
End If

Randomize

With Sheets("sheet1")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With

For Icntr = LastCol To 4 Step -1
    Columns(Icntr).EntireColumn.ClearContents
Next

Sheets("sheet1").Range("C" & 1) = "NAMES"
Sheets("sheet1").Range("A1:A" & Lastrow).Copy Destination:=Sheets("sheet1").Range("C" & 2)
Application.CutCopyMode = False

If Lastrow Mod 2 <> 0 Then
    MsgBox "Some one's not playing!"
End If

ColNum = 4
Games = 0

StartAgain:

Cnt = 0

Do

abovefirstrow:

    If Cnt > 1000 Then
        Sheets("sheet1").Range("B1:B" & Lastrow).ClearContents
        Games = Games + 1
            If Games = ToTGames Then
                Exit Sub
            Else
                Counter = 0
                ColNum = ColNum + 1
                GoTo StartAgain
            End If
    End If
    
    FirstRow = Int((Lastrow * Rnd) + 1)
    
    If Sheets("sheet1").Range("B" & FirstRow).Value <> vbNullString Then
        Cnt = Cnt + 1
        GoTo abovefirstrow
    End If
    
abovesecondrow:

    SecondRow = Int((Lastrow * Rnd) + 1)
    
    If Sheets("sheet1").Range("B" & SecondRow).Value <> vbNullString Then
        GoTo abovesecondrow
    End If
    
    If FirstRow = SecondRow Then
        Cnt = Cnt + 1
        GoTo abovefirstrow
    End If
    
    If Sheets("sheet1").Range("A" & FirstRow).Value = _
        Sheets("sheet1").Range("A" & SecondRow).Value Then
        Cnt = Cnt + 1
        GoTo abovefirstrow
    End If
    
    If ColNum > 4 Then
        For ColCnt = 4 To ColNum
            If Sheets("sheet1").Range("A" & SecondRow).Value = Sheets("sheet1").Cells(FirstRow + 1, ColCnt).Value Or _
                Sheets("sheet1").Range("A" & FirstRow).Value = Sheets("sheet1").Cells(SecondRow + 1, ColCnt).Value Then
                Cnt = Cnt + 1
                GoTo abovefirstrow
            End If
        Next ColCnt
    End If
    
    Sheets("sheet1").Cells(1, ColNum).Value = "GAME " & ColNum - 3
    Sheets("sheet1").Cells(FirstRow + 1, ColNum).Value = Sheets("sheet1").Range("A" & SecondRow).Value
    Sheets("sheet1").Cells(SecondRow + 1, ColNum).Value = Sheets("sheet1").Range("A" & FirstRow).Value
    Sheets("sheet1").Range("B" & FirstRow).Value = "Done"
    Sheets("sheet1").Range("B" & SecondRow).Value = "Done"
    Counter = Counter + 1
    
    If Counter = Lastrow Then
        Sheets("sheet1").Range("B1:B" & Lastrow).ClearContents
        Games = Games + 1
        If Games = ToTGames Then
            Exit Sub
        Else
            Counter = 0
            ColNum = ColNum + 1
            GoTo StartAgain
        End If
    End If
Loop

End Sub


Sub clrData()
    Sheet1.Range("C1:AZ500").Value = ""
End Sub

Download workbook : Internxt Drive – Private & Secure Cloud Storage

Change the numbers in Col A to the names of the players ... or you can assign a different number to each player and use the workbook that way.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
Find teams using a found average
Replies
5
Views
522
Burrgogi
Burrgogi
S
  • Question Question
Creating a random sequence of items from a weighted list with no duplicates
Replies
6
Views
648
shg
shg
R
  • Question Question
Golf scoring game
Replies
4
Views
743
Rock5150
R
S
  • Question Question
Golf Trip Pairings for 18 (3x6) with least amount of Repeats
Replies
0
Views
785
slaney7
S
SteveP29
  • Solved
Golf Skins
Replies
3
Views
712
Fluff
Fluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top