Trying to pair names randomly into teams??

[poop91407]

First off, I'm a novice at excel.

I need some help. I work at a golf course.
At work, I need to randomly pair players together to form teams.

For example:
Saturday morning, there are 19 golfers signed up to play together, but want to paired randomly.

This is what we currently do:
In cells A1:A27 I type their names. In B1:B27, I type their handicaps.

We then use a deck of cards to randomly draw teams. We do this by pulling 4-A's, 4-k's, 4-Q's, 4-J's, and 3-10's from the deck. We shuffle these cards and then go down the names in colum A and assign each palyer a card and place the card value into column C. We then highlight all three columns and sort by column C to form teams.

This works ok, but the problem is they all tee off at the same time and need a "super quick" process to form teams in seconds.

The only variable that I might see being a problem is the # of players vary each time they play. There might be 12 one day and 51 the next. We have to form teams into 4 somes and 3 somes, based on the total number of players we get.

Any help appreciated... The easier the better!! Thanks!

 

[alphaexcel]

You could use the RAND() function to generate a random number for each person. Then cut/paste the random values (otherwise they will referesh each time the sheet is calculated) then order based on the size of the random number. Group them in pairs in ascending order. Sure there is a more elegant way to do it, this is just a quick off-the-cuff note to get you started.

 

[jindon]

vba, if you like
1) hit Alt + F11
2) go to [Insert] - [Module] then paste the code onto the right pane
3) hit Alt + F11 again to get back to Excel
4) hit Alt + F8, then choose "test" and hit [Run]
try

Sub test()
Dim a, i As Long, ii As Integer, 4Some As Long, 3Some As Long
Dim b(), teamNum As Long, n As Long
With Range("a1").CurrentRegion.Resize(,2)
    a = .Value
    ReDim Preserve a(1 To UBound(a,1), 1 To 3)
    Randomize
    For i = 1 To UBound(a,1)
        a(i,3) = Rnd
    Next
    VSortMA a, 1, UBound(a,1), 3
    3Sum = Choose((UBound(a,1) Mod 4) + 1, 0,3,2,1)
    4Some = Application.RoundUp(UBound(a,1) / 4, 0) - 3Some
    ReDim b(1 To 3Some + 4Some, 1 To 9)
    For i = 1 To 4Some
        teamNum = teamNum + 1
        b(teamNum, 1) = teamNum
        For ii = 1 To 8 Step 2
            n = n + 1
            b(teamNum, ii + 1) = a(n, 1)
            b(teamNum, ii + 2) = a(n, 2)
        Next
    Next
    If 3Some > 0 Then
        For i = 1 To 3Some
            teamNum = teamNum + 1
            b(teamNum, 1) = teamNum
            For ii = 1 To 6 Step 2
                n = n + 1
                b(teamNum + 4Some, ii + 1) = a(n, 1)
                b(teamNum + 4Some, ii + 2) = a(n, 2)
            Next
        Next
    End If
    With .Offset(,4).Resize(1,1)
        .CurrentRegion.Clear
        .Resize(,3).Value = [{"Team #","Player1","Hcap"}]
        With .Offset(,1).Resize(,2)
            .Autofill .Resize(,8)
        End With
        With .Offset(1).Resize(teamNum, 8)
            .Value = b
            .Borders.Weight = xlHairLine
            .BorderAround Weight:=xlThin
            .EntireColumn.AutoFit
        End With
    End With
End With
End Sub
 
Private Sub VSortMA(ary, LB, UB, ref) 
Dim M As Variant, i As Long, ii As Long, iii As Long
i = UB : ii = LB 
M = ary(Int((LB+UB)/2),ref) 
Do While ii <= i 
     Do While ary(ii,ref) < M 
          ii = ii + 1 
     Loop 
     Do While ary(i,ref) > M 
          i = i - 1 
     Loop 
     If ii <= i Then 
          For iii = LBound(ary,2) To UBound(ary,2) 
               temp = ary(ii,iii) : ary(ii,iii) = ary(i,iii)
               ary(i,iii) = temp 
          Next 
          ii = ii + 1 : i = i - 1 
     End If 
Loop 
If LB < i Then VSortMA ary, LB, i, ref 
If ii < UB Then VSortMA ary, ii, UB, ref 
End Sub

 

[MickG]

Hi, This code will randomly enter all the players names from column "A" in Column "C", Divided by colour into groups of 4.

Dim x As Range, RanRng As Range, z As Range, oRes, Ray
Dim i As Integer, j As Integer, real, oSt As Integer, cl As Range
Dim oCol As Integer

Set RanRng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Ray = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Value
    ReDim oRes(1 To RanRng.Rows.Count)
       RanRng.Offset(, 2).ClearContents
            RanRng.Offset(, 20).ClearContents
oCol = 35
For Each cl In RanRng.Offset(, 2)
     cl.Interior.ColorIndex = oCol
   If cl.Row Mod 4 = 0 And oCol = 34 Then
        oCol = 35
      ElseIf cl.Row Mod 4 = 0 And oCol = 35 Then
          oCol = 34
        End If
 Next cl

For Each x In RanRng.Offset(, 20)
    j = Int(Rnd() * RanRng.Rows.Count) + 1
Set z = RanRng.Offset(, 20).Find(j, lookat:=xlWhole)
    While Not z Is Nothing
        j = Int(Rnd() * RanRng.Rows.Count) + 1
Set z = RanRng.Offset(, 20).Find(j, lookat:=xlWhole)
Wend
x = j
oRes(x.Row) = j
Next x
ReDim real(1 To RanRng.Rows.Count)

For oSt = 1 To UBound(oRes)
    real(oSt) = Cells(oRes(oSt), 1)
Next oSt
Range("C1").Resize(RanRng.Count).Value = Application.Transpose(real)

Regards Mick

 

[poop91407]

Thnaks for the help, but I get "compile error"?

Not really sure if I'm doing it right?

First time using VBA's.

Any suggestions??

 

[MickG]

Hi, Is that My code or Jindon's ??
I have tried Jindon's , and I also Get "Compile Error" ,Syntax Error, it is to do with the way he's declared the variables, Normally they must begin with a letter, whether you can start with a number (as he has) in excel 2007 I don't know. Have a go with mine, see what results you get.
I haven't accounted for any possible headers, so perhaps you trial run should be just Names in Column "A".
Regards Mick

 

[poop91407]

Hi, Is that My code or Jindon's ??
I have tried Jindon's , and I also Get "Compile Error" ,Syntax Error, it is to do with the way he's declared the variables, Normally they must begin with a letter, whether you can start with a number (as he has) in excel 2007 I don't know. Have a go with mine, see what results you get.
I haven't accounted for any possible headers, so perhaps you trial run should be just Names in Column "A".
Regards Mick

I tried yours also with no success....
What do I do after I cut and paste the code?
I tried to test and run...
and I get an error?
does yours work for you? or did you not test it?

Again, thanks for all your help... MUCH appreciated.

Mike

 

[MickG]

Hi, Try a Command Button, Have a read of the following:-
and "Yes" The code was working when I tested it up to about 50 names in column "A".
---------------
Inserting a Command Button in worksheet and Allocating Code

Open your workbook at the Sheet Number with your Data that you want to Manipulate.
Click View, Tools, Control Box,---- Control Box Menu Appears on sheet.
Slide you cursor over the Tool Box until you find a Command Button.
Click It then click Somewhere on the sheet.-- Command Button appears on sheet.
The Command Button will have handles round its edge, This is so you can Position it on the sheet.
Click the command Button "Hold the Mouse Click Down" and Drag the Command Button to where you want it.
Double Click the Command Button, The VB Editor window will appear.
You can also open the Editor By clicking Alt + F11, but if you double click the Command Button the editor will open in the procedure relating specifically to your Command Button.
If the VB Editor window has two panes the right pane is where you must paste your code.
The left pane can be "Project Window" or "Properties Window, Click "Ctrl+R" if not showing.
Paste your code just under the words "Private Sub CommandButton1_Click() " in the Right hand pane.
If you have done this correctly. Scroll to the bottom of the code and you should see the words "End Sub"
On the VB Toolbar you will see a Green Triangular shapes icon,.
This is to change the VB Editor mode from "Run Mode" to "Design Mode "
Click this Icon, The Small blue square to its left will change from light blue to dark blue, or Vice Versa. Before you close the Editor make sure this Square is "Dark Blue" i.e. (Reset)
Sometimes the it will appear Reset when it is not, that why I usually (Not in this case) put a message at the bottom of the code, to know if is run or not.
Close the Editor. Select the Command Button and Click it.
When the code Runs the Msgbox should appear With The Message "Transfer Complete" ,if this doesn't happen Open The VB Editor "Alt + F11" and click the "Reset ( Blue Square) and or The "Green Triangle" on the Tool bar . The Blue Square should be "Dark Blue ", in order to run the code..
NB:- If you want to get back into this specific code through the Command Button.
Get the Control Box menu back on the screen, Click the green triangle, When you slide the cursor over your Command button , The cursor shape will change to a "Arrow Headed Cross" , you will then be able to double click it to view your code.
If you prefer, you can forgo all this hassle by putting the code in an MT macro, with a key combination like (Ctrl+"A") to run it.
Don't be daunted by all this, when you get the hang of it, it will seem quite simple
---------------------
If yoe want a msgbox paste the following above the word "End Sub"

Msgbox "Complete"

NB:-
Make sure you copy the whole code (Mind the scrollBars)
I've just copied the code back from the thread.
I Typed -- Name1-- in cell "A1", dragged it down the sheet to about row 50 Giving Names1 to Names50, clicked the Button.
Column "C" returned the Results list.
Have another go
Good Luck Mick

 

[jindon]

I tried yours also with no success....
What do I do after I cut and paste the code?
I tried to test and run...
and I get an error?
does yours work for you? or did you not test it?

Again, thanks for all your help... MUCH appreciated.

Mike

Mike

When you run my code;

1) what was the error exactly ?
2) which line was higlited?

 

[poop91407]

Mick..

Works really well. Just need one tweak if possible.

I would like it to form teams of 3's and 4's only. Is it possible?

Your current code allows teams of 2's, which doesn't work in the game we play.

btw... your directions were emaculate.... THANKS.