Random selection with rules

denismccarthy

Board Regular
Joined
Dec 30, 2006
Messages
108
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

Thanks in advance.

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
13DFM CamaraDER3.2
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,

couple of comments.

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
        z.Add a(x, 2), Empty
        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
        z.Add a(x, 2), Empty
        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
        z.Add c(i, 3), 1
    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
Joined
Dec 30, 2006
Messages
108
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.
 

Forum statistics

Threads
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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top