Hey Guys and gals,

I run a small football (or soccer :P) club and ever week I have to pick
random teams.

I would like to have a small VBA routine that has a button on my main
excel screen and when clicked will take the 14 players and randomise
them into 2 groups of 7.

Someone did say use the randomise function but I'd like it so if I am
not happy with the results I can just click and run it again.

Can anyone help ???

Jayce


---
Message posted from http://www.ExcelForum.com/

Hi Jayce

Open the VB editor (Alt F11 or similar). Insert Module (with that menu).
Paste this in:

Option Explicit

Type Player
D As Double
S As String
End Type

Sub ShufflePlayers()
Dim Players() As Player
Dim Tmp As Player
Dim R As Range
Dim R2 As Range
Dim Cel As Range
Dim L As Long
Dim M As Long
'select players
Set R = Application.InputBox("Select your contestants:", _
Default:=Selection.Address, _
Type:=8)
If R Is Nothing Then Exit Sub
ReDim Players(1 To Selection.Count)
Randomize
L = 0
'attatch a random number to each:
For Each Cel In R
L = L + 1
Players(L).D = Rnd()
Players(L).S = Cel.Value
Next
'sort by those numbers:
For L = 1 To UBound(Players) - 1
For M = 1 To UBound(Players) - 1
If Players(M).D Players(M + 1).D Then
Tmp.D = Players(M + 1).D
Tmp.S = Players(M + 1).S
Players(M + 1).D = Players(M).D
Players(M + 1).S = Players(M).S
Players(M).D = Tmp.D
Players(M).S = Tmp.S
End If
Next
Next
'paste the result:
Set R2 = Application.InputBox("Where should I paste this ?:", _
Default:=Selection(1).Offset(0, 2).Address, _
Type:=8)
If R2 Is Nothing Then Exit Sub
If R2.Count < R.Count Then Set R2 = R2(1).Resize(R.Count, 1)
L = 0
For Each Cel In R2
L = L + 1
Cel.Value = Players(L).S
Next
End Sub

Now it's ready to run. Return to Excel and test.

HTH. Best wishes Harald


"Bigjayce " skrev i melding
...
Hey Guys and gals,

I run a small football (or soccer :P) club and ever week I have to pick
random teams.

I would like to have a small VBA routine that has a button on my main
excel screen and when clicked will take the 14 players and randomise
them into 2 groups of 7.

Someone did say use the randomise function but I'd like it so if I am
not happy with the results I can just click and run it again.

Can anyone help ???

Jayce


---
Message posted from http://www.ExcelForum.com/

Oops. Put
On Error Resume Next
between
'select players
and
Set R = ...

Best wishes Harald

"Harald Staff" skrev i melding
...
Hi Jayce

Open the VB editor (Alt F11 or similar). Insert Module (with that menu).
Paste this in:

Option Explicit

Type Player
D As Double
S As String
End Type

Sub ShufflePlayers()
Dim Players() As Player
Dim Tmp As Player
Dim R As Range
Dim R2 As Range
Dim Cel As Range
Dim L As Long
Dim M As Long
'select players
Set R = Application.InputBox("Select your contestants:", _
Default:=Selection.Address, _
Type:=8)
If R Is Nothing Then Exit Sub
ReDim Players(1 To Selection.Count)
Randomize
L = 0
'attatch a random number to each:
For Each Cel In R
L = L + 1
Players(L).D = Rnd()
Players(L).S = Cel.Value
Next
'sort by those numbers:
For L = 1 To UBound(Players) - 1
For M = 1 To UBound(Players) - 1
If Players(M).D Players(M + 1).D Then
Tmp.D = Players(M + 1).D
Tmp.S = Players(M + 1).S
Players(M + 1).D = Players(M).D
Players(M + 1).S = Players(M).S
Players(M).D = Tmp.D
Players(M).S = Tmp.S
End If
Next
Next
'paste the result:
Set R2 = Application.InputBox("Where should I paste this ?:", _
Default:=Selection(1).Offset(0, 2).Address, _
Type:=8)
If R2 Is Nothing Then Exit Sub
If R2.Count < R.Count Then Set R2 = R2(1).Resize(R.Count, 1)
L = 0
For Each Cel In R2
L = L + 1
Cel.Value = Players(L).S
Next
End Sub

Now it's ready to run. Return to Excel and test.

HTH. Best wishes Harald


"Bigjayce " skrev i melding
...
Hey Guys and gals,

I run a small football (or soccer :P) club and ever week I have to pick
random teams.

I would like to have a small VBA routine that has a button on my main
excel screen and when clicked will take the 14 players and randomise
them into 2 groups of 7.

Someone did say use the randomise function but I'd like it so if I am
not happy with the results I can just click and run it again.

Can anyone help ???

Jayce


---
Message posted from http://www.ExcelForum.com/

WOW :) Thanks harold :)

quick question, I have a list in an excel spreadsheet of the player
names - could this be modded to look at that list and jumble them up ?

Jayc

--
Message posted from http://www.ExcelForum.com

Yes. Need more detail for a suggestion though. Is it in the same workbook as
the code ? If not, is the file open ? Which sheet and range is the list ?


"Bigjayce " skrev i melding
...
WOW :) Thanks harold :)

quick question, I have a list in an excel spreadsheet of the players
names - could this be modded to look at that list and jumble them up ?

Jayce


---
Message posted from http://www.ExcelForum.com/

would I be able to send the sheet directly to you so you have it i
front of you

--
Message posted from http://www.ExcelForum.com

On the sheet I have a list of names in b3:b16

There is a button on the sheet saying 'Pick Teams'

Team one needs to go in f24:f30 and team two in g24:g30

Hope this helps :

--
Message posted from http://www.ExcelForum.com

Try hstf at hotmail dot com, and I'll try to look into it. Please zip it
first if possible.

Best wishes Harald

"Bigjayce " skrev i melding
...
would I be able to send the sheet directly to you so you have it in
front of you ?


---
Message posted from http://www.ExcelForum.com/

Hi Harold,

Did you recieve the file ?

Jayc

--
Message posted from http://www.ExcelForum.com

"Bigjayce " skrev i melding
...
Hi Harold,

Did you recieve the file ?

Yes. I'll look at it as soon as possible. (Some tasks have higher priority
by default, sorry ;-)

Best wishes Harald

Solution emailed.

Harald

and greatly appriciated :

--
Message posted from http://www.ExcelForum.com