Comparing Excel Arrays for a Golf Draw over 5 Days

[Peterg4352]

20 people go away on a golf trip for 5 days.
Each day has a different "draw" (4 players per group).
The test is that all groups within the trip, must be unique.
I use a random number generator to "randomise" the new groups.

I have tried using this array formulae to test the arrays
={SUM(IF(E10:H10=$E$18:$H$18,1,0))}
The test answer should be greater that 1 if the players on Tuesday have been drawn in the same group on Monday i.e. two players in Monday group 3 are drawn again on Tuesday group 2 but the test indicates that they are not duplicates.

I need some help with the test for duplicates?

Monday	Player 1	Player 2	Player 3	Player 4	<tbody> </tbody>
Group 1	Mr B	Mr L	Mr K	Mr R
Group 2	Mr Q	Mr E	Mr F	Mr J
Group 3	Mr D	Mr M	Mr H	Mr G
Group 4	Mr O	Mr S	Mr I	Mr C
Group 5	Mr A	Mr N	Mr P	Mr T
						Test Monday Groups
Tuesday	Player 1	Player 2	Player 3	Player 4		1	2	3	4	5	6
Group 1	Mr B	Mr Q	Mr O	Mr N		1	0	0	0	0	0
Group 2	Mr H	Mr P	Mr K	Mr D		1	0	0	0	0	0
Group 3	Mr E	Mr J	Mr A	Mr M		0	0	0	0	0	0
Group 4	Mr T	Mr I	Mr S	Mr L		0	0	0	0	0	0
Group 5	Mr C	Mr R	Mr F	Mr G		0	1	1	0	0	0

<tbody>
</tbody><colgroup><col><col span="4"><col span="7"></colgroup>

 

[Eric W]

Maybe:

Excel 2010

	D	E	F	G	H	I	J	K	L	M	N	O
6	Monday	Player 1	Player 2	Player 3	Player 4
7
8	Group 1	Mr B	Mr L	Mr K	Mr R
9	Group 2	Mr Q	Mr E	Mr F	Mr J
10	Group 3	Mr D	Mr M	Mr H	Mr G
11	Group 4	Mr O	Mr S	Mr I	Mr C
12	Group 5	Mr A	Mr N	Mr P	Mr T
13
14
15							Test Monday Groups
16	Tuesday	Player 1	Player 2	Player 3	Player 4		1	2	3	4	5	6
17	Group 1	Mr B	Mr Q	Mr O	Mr N		1	1	0	1	1	0
18	Group 2	Mr H	Mr P	Mr K	Mr D		1	0	2	0	1	0
19	Group 3	Mr E	Mr J	Mr A	Mr M		0	2	1	0	1	0
20	Group 4	Mr T	Mr I	Mr S	Mr L		1	0	0	2	1	0
21	Group 5	Mr C	Mr R	Mr F	Mr G		1	1	1	1	0	0

<tbody>
</tbody>

Sheet1​

Array Formulas Cell Formula J17 {=SUM(--ISNUMBER(MATCH($E17:$H17,OFFSET($E$8:$H$8,COLUMNS($J17:J17)-1,0),0)))} <tbody> </tbody> Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}. Note: Do not try and enter the {} manually yourself

<tbody>
</tbody>

Put the formula in J17, then you can copy it down and across as needed. For the other days, you'll need to adapt the ranges and column references. Let me know how that works.

Depending on how you generate your foursomes, it might be easier to create a VBA macro to create them. Eliminating duplicates could be part of the macro. This could possibly save you some time.

 

[Peterg4352]

Hi Eric
Many thanks for your advice and my apologies for the delay in replying.
Public Holiday in Australia on Tuesday followed by a very busy catch up day.

Using your code I was not able to replicate your "test" results
but
When I modified the code to delete the OFFSET command as follows:
=SUM(--ISNUMBER(MATCH($E19:$H19,$E$13:$H$13,0)))
SUCCESS
At the end of the day I was only comparing two arrays
The use of the --ISNUMBER and converting the formula to an Array Formula (CSE) made all the difference.

Now that my test is working your comment that the random name generation for the foursome draw is time-consuming is perfectly correct.
It will take forever to randomly generate groups that will satisfy the test.

Can you point me towards some VBA code that will manage the draw?
I am not a VBA expert but can "bumble" my way through the code if given a head start!!

Once again many thanks for your advice.
Very much appreciated.
Peter G

 

[Eric W]

I'm glad you got the test working. I'll try to write up some code as soon as I can. I'll let you know.

 

[Eric W]

I was mentally designing the program. I was a little worried. There are billions of possible combinations, but there are trillions of combinations that don't work. Even with tests at every point, the last foursome of the day might not work, and I'd have to start over.

Then inspiration struck. I manually created a single pattern that works for the entire week. Then I randomly sorted the name list and inserted the names into the pattern. Voila! It instantly creates a list of 5 foursomes over 5 days, and no one ever plays with the same person twice. You can run it as often as you like. You'll probably see a pattern in the list, but if you use your formula to check them, they should all be OK.

To use:

1) Open an empty workbook
2) Put the list of names in A1:A20
3) Right click on the sheet tab on the bottom of the window and select "View Code"
4) Paste the following code into the window that opens

Sub Scramble()
Dim Fours(5, 4), MyDays, MyMod, Names1, Names2
Dim x As Integer, r As Integer, c As Integer, MyRow As Integer

' Define a few constants
    MyDays = Array("", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
    MyMod = Array(0, 0, 16, 12, 8)
    
' Set up Monday's foursomes
    x = 1
    For r = 1 To 5
        For c = 1 To 4
            Fours(r, c) = x
            Cells(x, "B") = Rnd()
            x = x + 1
        Next c
    Next r
    
' Save the original order of names
    Names1 = Range("A1:A20")
    
' Sort the names randomly
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1:B20")
        .SetRange Range("A1:B20")
        .Orientation = xlTopToBottom
        .Apply
    End With
    
' Save the sorted order
    Names2 = Range("A1:A20")
    
' Restore the original list
    Range("A1:A20") = Names1
    Range("B1:B20").ClearContents
    
' Starting row
    MyRow = 2
    
' Do 5 times, once for each day
    For x = 1 To 5
    
' Create the foursomes, using "Fours" as an index into Names2
        Cells(MyRow, "F") = MyDays(x)
        For r = 1 To 5
            Cells(MyRow + r, "F") = "Group" & r
            For c = 1 To 4
                Cells(MyRow + r, c + 6) = Names2(Fours(r, c), 1)
            Next c
        Next r
        
' Now rearrange the indices
        For r = 1 To 5
            For c = 2 To 4
                Fours(r, c) = (Fours(r, c) + MyMod(c)) Mod 20
                If Fours(r, c) = 0 Then Fours(r, c) = 20
            Next c
        Next r
        
        MyRow = MyRow + 8
    Next x
    
End Sub

5) Return to the Excel window
6) Press Alt-F8 to open the macro selection box
7) Select Scramble and click Run

That should do it. Let me know how it works.

 

[Peterg4352]

He Eric

Love your inspiration ..... the pattern is so simple it is scary!!
I have inserted it into my spreadsheet and as you suspected the previous test showed it was a perfect random draw with no "repeat" players over the five days.
Well done

Many Thanks
Now all I have to do is worry about my golf game!!

Peter G

 

[Eric W]

Well, I can't help you with your golf game, I usually wear a mask when I play so no one will recognize me!

I'm glad the routine works for you - have fun on your trip!

 

[cnestg8r]

error

 

[moze83]

Hi Eric, Nice job! I'm interested in this macro too. Could it also be applied to groups of four with 48 players and 10 rounds instead of 5 days?

Cheers,

Kaz

 

[Eric W]

Hi Kaz,

Thanks for the interest. I'm sure that it could be applied, but I haven't quite figured it out yet. As you may have noticed, the original solution required that I find a pattern manually before I could program it. That pattern does not work for 12 foursomes instead of just 5. I thought I came up with a different pattern that would work, but no such luck. Here's what I have:

Sub Scramble()
Dim Fours(12, 4), MyDays, MyMod, Names1, Names2
Dim OldFours
Dim x As Integer, r As Integer, c As Integer, MyRow As Integer

' Define a few constants
    MyDays = Array("", "Round 1", "Round 2", "Round 3", "Round 4", "Round 5", _
                       "Round 6", "Round 7", "Round 8", "Round 9", "Round 10")
    MyMod = Array(0, 0, 1, 5, 7)
    
' Set up Monday's foursomes
    x = 1
    For r = 1 To 12
        For c = 1 To 4
            Fours(r, c) = x
            Cells(x, "B") = Rnd()
            x = x + 1
        Next c
    Next r
    
' Save the original order of names
    Names1 = Range("A1:A48")
    
' Sort the names randomly
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1:B48")
        .SetRange Range("A1:B48")
        .Orientation = xlTopToBottom
        .Apply
    End With
    
' Save the sorted order
    Names2 = Range("A1:A48")
    
' Restore the original list
    Range("A1:A48") = Names1
    Range("B1:B48").ClearContents
    
' Starting row
    MyRow = 2
    
' Do 10 times, once for each round
    For x = 1 To 10
    
' Create the foursomes, using "Fours" as an index into Names2
        Cells(MyRow, "F") = MyDays(x)
        For r = 1 To 12
            Cells(MyRow + r, "F") = "Group" & r
            For c = 1 To 4
                Cells(MyRow + r, c + 6) = Names2(Fours(r, c), 1)
            Next c
        Next r
        
' Now rearrange the indices
        OldFours = Fours
        
        For r = 1 To 12
            For c = 2 To 4
                Fours(r, c) = OldFours((r - 1 + MyMod(c)) Mod 12 + 1, c)
            Next c
        Next r
        
        MyRow = MyRow + 15
    Next x
    
End Sub

It's close, but some players do play with each other more than once. I suspect an acceptable pattern might not be quite so easy to find. I'll poke away at it a bit more and let you know what I come up with.