# Random selection with rules

#### denismccarthy

##### Board Regular
Hi all,

Would you be able to help or point me in the right direction. I'm creating a fantasy football competition in work and I want to write VBA code to be able to select a random team for people that are too busy.
Heres the rules
1) select 1 GK, 4 DF, 4 MD & 2 ST Based on column A
2) You can't pick the same player more than once from column B
3) You can't pick more than 3 players from 1 team from column C
4) the total cost can't exceed 55 from column D

Den
Book1
ABCD
1Po.NameTeamPrice
2GKJ LehmannARS4.4
3GKS TaylorAV3.3
4GKT SorensenAV3.6
5GKC DoyleBIR3.1
6GKS CarsonLIV4.4
7GKA IsakssonMC3.4
8DFA ColeCHE5.1
9DFG JohnsonCHE4.8
10DFP FerreiraCHE4.9
11DFW BridgeCHE4.9
12DFJ McEveleyDER3.3
14STD ConnollySUN5.6
15STD MurphySUN5.6
16STD YorkeSUN5.5
17STM ChopraSUN5.7
18STS JohnSUN5.5
19STD BentTOT6.8
20STD BerbatovTOT7.7
21STJ DefoeTOT6.4
22STR KeaneTOT6.8
23STB ZamoraWH6
Sheet2 (2)

### Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
L

#### Legacy 14611

##### Guest
hi,

no MD in your data so I used ST instead. code is easily modified if you want to include MD

no possible team gives a cost of 55. run the following code to see what happens. it assumes your data are in range(A1:D23) and required maximum cost is in cell F1
Code:
``````Sub selectteam()
[f2:i23].ClearContents
'total allowable cost is tac
tac = [f1]
a = [a2:d23]
waco:
t = t + 1
If t > 5000 Then GoTo fini
cst = 0
Set z = CreateObject("Scripting.Dictionary")
Dim c(1 To 11, 1 To 4)
Do
x = Int(Rnd * 22) + 1
If a(x, 1) = "GK" Then
c(1, 1) = "GK"
c(1, 2) = a(x, 2)
c(1, 3) = a(x, 3)
c(1, 4) = a(x, 4)
Exit Do
End If
Loop

Do
n = n + 1
x = Int(Rnd * 22) + 1
If a(x, 1) = "DF" And Not z.exists(a(x, 2)) Then
p = p + 1
c(p + 1, 1) = "DF"
c(p + 1, 2) = a(x, 2)
c(p + 1, 3) = a(x, 3)
c(p + 1, 4) = a(x, 4)
End If
Loop Until p = 4 Or n = 1000
n = 0: p = 0: z.removeall

Do
n = n + 1
x = Int(Rnd * 22) + 1
If a(x, 1) = "ST" And Not z.exists(a(x, 2)) Then
p = p + 1
c(p + 5, 1) = "ST"
c(p + 5, 2) = a(x, 2)
c(p + 5, 3) = a(x, 3)
c(p + 5, 4) = a(x, 4)
End If
Loop Until p = 6 Or n = 1000
n = 0: p = 0: z.removeall
For i = 1 To 11
If Not z.exists(c(i, 3)) Then
Else: z.Item(c(i, 3)) = z.Item(c(i, 3)) + 1
If z.Item(c(i, 3)) > 3 Then GoTo waco
End If
Next i

For i = 1 To 11
cst = cst + c(i, 4)
Next i
If cst > tac Then GoTo waco:
[i15] = cst
[f2].Resize(11, 4) = c
[f15].Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
[h15] = "Cost is:"
fini: [f23] = t & " iterations"
If t > 5000 Then [f2] = "No such team exists with cost not exceeding " & tac
End Sub``````

#### denismccarthy

##### Board Regular
Thanks rugila.

The sample of data was only a fraction of the info. Looking at your code, It'spointing me in the right direction. I'll post the final code when I get it working.

Replies
7
Views
1K
Replies
3
Views
690
Replies
0
Views
600
Replies
5
Views
509
Replies
6
Views
565

1,181,103
Messages
5,928,077
Members
436,587
Latest member
Slicesofquince

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