Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A small project

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/

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 292
Default A small project

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/



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 292
Default A small project

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/





  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A small project

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

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 292
Default A small project

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/





  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A small project

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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Small? Shu of AZ Excel Discussion (Misc queries) 0 April 4th 08 04:18 PM
ISERROR,SMALL,INDEX, MATCH, SMALL?? M.A.Tyler Excel Discussion (Misc queries) 1 May 2nd 07 04:08 AM
Excell error "Can't find Project or Library" Project VBAProject Lost in Excel Excel Worksheet Functions 0 April 12th 07 04:42 PM
How to convert MS Project to MS Excel. I don't have MS Project. Jane Excel Discussion (Misc queries) 1 February 20th 06 10:01 PM
small excel project leonard Excel Programming 5 January 23rd 04 08:29 AM


All times are GMT +1. The time now is 02:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"