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/