|
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/ |
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/ |
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/ |
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 |
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/ |
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 |
A small project
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 |
A small project
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/ |
A small project
|
A small project
"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 |
Re2: A small project
Solution emailed.
Harald |
A small project
|
| All times are GMT +1. The time now is 10:05 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com