# Trying to pair names randomly into teams??

#### poop91407

##### New Member
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!

### Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

#### alphaexcel

##### Board Regular
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

##### MrExcel MVP
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
Code:
``````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

##### MrExcel MVP
Hi, This code will randomly enter all the players names from column "A" in Column "C", Divided by colour into groups of 4.
Code:
``````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

##### New Member
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

##### MrExcel MVP
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

##### New Member
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

##### MrExcel MVP
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"
Code:
``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

##### MrExcel MVP
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

##### New Member
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.

Replies
1
Views
61
Replies
3
Views
2K
Replies
2
Views
934
Replies
3
Views
2K
Replies
8
Views
993

1,191,194
Messages
5,985,220
Members
439,948
Latest member
Xearo96

### 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.

### Which adblocker are you using?

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

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