Creating exception to random Team generator

[paulgunther]

I have a spreadsheet that assigns players to random holes (Start) based on a chosen number of players per card (I3). It's fairly simple and I also have a macro assigned to a button that copies the "random" column and pastes values to the "static" column to re-randomize at will. The "hole_assignment" table is to assign the holes in a specific, non-sequential order. This works fine as designed.

Question: I would like to occasionally assign certain players to specific holes (column A) and have the Start column account for the pre-assigned starting hole and randomize the rest.

Example: Player 2, pre-assigned hole 8, Player 6 pre-assigned hole 8. I now need the randomizer to only assign 2 additional players to hole 8 and automatically place those players on their respective pre-assigned holes.

Random Card.xlsm
	A	B	C	D	E	F	G	H	I
1
2	Non RandomCard	Player	Start	Group	Random	Static
3		Player 1	2	7	0.226304354	0.262627438		Card Size	4
4	8	Player 2	8	2	0.387937938	0.796961803
5		Player 3	10	3	0.670163485	0.68759244		Card	Assigned Hole
6		Player 4	4	6	0.538938097	0.351944739		1	1
7		Player 5	10	3	0.640843928	0.746840218		2	8
8	8	Player 6	10	3	0.873793276	0.75425269		3	10
9		Player 7	12	4	0.565404705	0.627886504		4	12
10		Player 8	1	1	0.498849178	0.879518872		5	6
11		Player 9	9	10	0.093233421	0.049763293		6	4
12		Player 10	13	9	0.79731487	0.098552824		7	2
13		Player 11	1	1	0.681900928	0.889456719		8	11
14		Player 12	6	5	0.740893852	0.569148347		9	13
15		Player 13	1	1	0.34068696	0.865395664		10	9
16		Player 14	4	6	0.923313534	0.369695062		11	3
17		Player 15	13	9	0.753195094	0.13534933		12	7
18		Player 16	11	8	0.887033833	0.211141552		13	18
19		Player 17	4	6	0.660317525	0.517424354		14	5
20		Player 18	6	5	0.753272601	0.554959501
21		Player 19	6	5	0.515377527	0.524942895
22		Player 20	11	8	0.274246457	0.256438207
23		Player 21	13	9	0.425123745	0.149393574
24		Player 22	9	10	0.63186222	0.026967303
25		Player 23	9	10	0.34139667	0.096754073
26		Player 24	4	6	0.805169222	0.388082165
27		Player 25	12	4	0.499807002	0.615633054
28		Player 26	11	8	0.772128409	0.217260568
29		Player 27	2	7	0.72363209	0.292360797
30		Player 28	1	1	0.16761252	0.905538699
31		Player 29	2	7	0.496709159	0.270637506
32		Player 30	6	5	0.172285652	0.564299634
33		Player 31	2	7	0.187167301	0.261168275
34		Player 32	8	2	0.463677877	0.784721414
35		Player 33	8	2	0.339954398	0.782527076
36		Player 34	8	2	0.547129477	0.796425025
37		Player 35	11	8	0.330512737	0.201663754
38		Player 36	10	3	0.704270874	0.764741023
39		Player 37	12	4	0.120979336	0.597508326
40		Player 38	12	4	0.62031941	0.639348663
41		Player 39	13	9	0.944448148	0.195836014
42		Player 40	9	10	0.729146253	0.047685875
WORKING

Cell Formulas
Range	Formula
C3:C42	C3	=VLOOKUP([@Group],Hole_Assignment,2)
D3:D42	D3	=CEILING(RANK([@Static],[Static])/$I$3,1)
E3:F42	E3	=RAND()

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A3:A42	Expression	=COUNTIF($A$3:$A$42, A3) = 2	text	NO
A3:A42	Expression	=COUNTIF($A$3:$A$42, A3) = 3	text	NO
A3:A42	Expression	=COUNTIF($A$3:$A$42, A3) = 4	text	NO
C3:C42	Expression	=COUNTIF($C$3:$C$42, C3) = 2	text	NO
C3:C42	Expression	=COUNTIF($C$3:$C$42, C3) = 3	text	NO
C3:C42	Expression	=COUNTIF($C$3:$C$42, C3) = 4	text	NO
C3:C42	Expression	=COUNTIF($C$3:$C$42, C3) = 5	text	NO
C3:C42	Expression	=COUNTIF($C$3:$C$42, C3) > 5	text	NO
B3:B42	Cell Value	duplicates	text	NO

Cells with Data Validation
Cell	Allow	Criteria
B2	Any value
C3:D42	Any value

 

[BSALV]

Holes

Sub Random()
     Dim SCA, i, r, k, s, LO_P, LO_HA, Arr, Arr_P, Arr_HA, Res

     t = Timer
     Set SCA = CreateObject("system.collections.arraylist")
     Set LO_P = Sheets("Blad1").ListObjects("TBL_Players")     '
     Arr_P = LO_P.DataBodyRange
     col2 = LO_P.DataBodyRange.Columns(2)
     ReDim Res(1 To UBound(Arr_P), 1 To 1)

     Arr = Sheets("Blad1").ListObjects("Hole_Assigment").DataBodyRange
     Arr_HA = Arr
     col1 = Application.Index(Arr, 0, 1)     '1st column = cards
     ReDim Preserve Arr_HA(1 To UBound(Arr), 1 To UBound(Arr, 2) + 1)

     For i = 1 To UBound(Arr_P)     'all the players with a pre-assigned card
          If Len(Arr_P(i, 1)) > 0 Then
               r = Application.Match(Arr_P(i, 1), col1, 0)     'find card in 1st col
               If IsNumeric(r) Then
                    Arr_HA(r, UBound(Arr_HA, 2)) = Arr_HA(r, UBound(Arr_HA, 2)) + 1     'increment number of players with that card
                    Res(i, 1) = Arr_P(i, 1)     'assign player to that card
               Else
                    MsgBox "card not found, ERROR"
                    Res(i, 1) = "????"     'assign player to card "???"
               End If
          Else
               SCA.Add Arr_P(i, 2)     'arraylist of FREE players
          End If
     Next

     Do While SCA.Count     'as long as there are FREE players
          b = False
          i = WorksheetFunction.RandBetween(1, SCA.Count)      'take a random still Free player
          s = SCA.Item(i - 1)
          Arr = Evaluate("column(A1:Z1)")     'serie 1 to 26 (> number of cards
          For j = UBound(Arr_HA) To 1 Step -1     'choice a random card
               k = WorksheetFunction.RandBetween(1, j)     'take a random Free player
               l = Arr(k)
               If Arr_HA(l, UBound(Arr_HA, 2)) >= Range("Card_Size").Value Then
                    Arr(k) = Arr(j)
               Else
                    r = Application.Match(SCA.Item(i - 1), col2, 0)
                    If IsNumeric(r) Then Res(r, 1) = Arr_HA(l, 1)
                    Arr_HA(l, UBound(Arr_HA, 2)) = Arr_HA(l, UBound(Arr_HA, 2)) + 1     'increment number of players with that card
                    SCA.Remove SCA.Item(i - 1)
                    b = True
                    Exit For
               End If
          Next
          If Not b Then
               SCA.Remove SCA.Item(i - 1)
          End If
     Loop

     LO_P.ListColumns("Group").DataBodyRange.Value = Res
     'MsgBox Timer - t
End Sub

 

[paulgunther]

Holes

Sub Random()
     Dim SCA, i, r, k, s, LO_P, LO_HA, Arr, Arr_P, Arr_HA, Res

     t = Timer
     Set SCA = CreateObject("system.collections.arraylist")
     Set LO_P = Sheets("Blad1").ListObjects("TBL_Players")     '
     Arr_P = LO_P.DataBodyRange
     col2 = LO_P.DataBodyRange.Columns(2)
     ReDim Res(1 To UBound(Arr_P), 1 To 1)

     Arr = Sheets("Blad1").ListObjects("Hole_Assigment").DataBodyRange
     Arr_HA = Arr
     col1 = Application.Index(Arr, 0, 1)     '1st column = cards
     ReDim Preserve Arr_HA(1 To UBound(Arr), 1 To UBound(Arr, 2) + 1)

     For i = 1 To UBound(Arr_P)     'all the players with a pre-assigned card
          If Len(Arr_P(i, 1)) > 0 Then
               r = Application.Match(Arr_P(i, 1), col1, 0)     'find card in 1st col
               If IsNumeric(r) Then
                    Arr_HA(r, UBound(Arr_HA, 2)) = Arr_HA(r, UBound(Arr_HA, 2)) + 1     'increment number of players with that card
                    Res(i, 1) = Arr_P(i, 1)     'assign player to that card
               Else
                    MsgBox "card not found, ERROR"
                    Res(i, 1) = "????"     'assign player to card "???"
               End If
          Else
               SCA.Add Arr_P(i, 2)     'arraylist of FREE players
          End If
     Next

     Do While SCA.Count     'as long as there are FREE players
          b = False
          i = WorksheetFunction.RandBetween(1, SCA.Count)      'take a random still Free player
          s = SCA.Item(i - 1)
          Arr = Evaluate("column(A1:Z1)")     'serie 1 to 26 (> number of cards
          For j = UBound(Arr_HA) To 1 Step -1     'choice a random card
               k = WorksheetFunction.RandBetween(1, j)     'take a random Free player
               l = Arr(k)
               If Arr_HA(l, UBound(Arr_HA, 2)) >= Range("Card_Size").Value Then
                    Arr(k) = Arr(j)
               Else
                    r = Application.Match(SCA.Item(i - 1), col2, 0)
                    If IsNumeric(r) Then Res(r, 1) = Arr_HA(l, 1)
                    Arr_HA(l, UBound(Arr_HA, 2)) = Arr_HA(l, UBound(Arr_HA, 2)) + 1     'increment number of players with that card
                    SCA.Remove SCA.Item(i - 1)
                    b = True
                    Exit For
               End If
          Next
          If Not b Then
               SCA.Remove SCA.Item(i - 1)
          End If
     Loop

     LO_P.ListColumns("Group").DataBodyRange.Value = Res
     'MsgBox Timer - t
End Sub

Thanks BSALV. I am not even close to this level of programming. Do you have any explanations to accompany this code?

 

[Fluff]

What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[paulgunther]

Fluff, Thanks for the tip. Office 365

 

[Fluff]

Thanks for that.
A formula option, although I feel there must be a simpler way.

Fluff.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2	Non RandomCard	Player	Start	Group	Random	Static
3		Player 1	4	6	0.045608439	0.505865			Card Size	4
4	8	Player 2	11	8	0.619093779	0.474071
5		Player 3	9	10	0.457812361	0.011008			Card	Assigned Hole
6		Player 4	4	6	0.614129908	0.447861			1	1
7		Player 5	11	8	0.219062397	0.149915			2	8
8	8	Player 6	11	8	0.966240872	0.235066			3	10
9		Player 7	12	4	0.444106733	0.562627			4	12
10		Player 8	10	3	0.286864549	0.688805			5	6
11		Player 9	8	2	0.234460827	0.766998			6	4
12		Player 10	6	5	0.434736894	0.544279			7	2
13	1	Player 11	1	1	0.788473228	0.312539			8	11
14		Player 12	10	3	0.415441728	0.745614			9	13
15		Player 13	13	9	0.829383117	0.121125			10	9
16		Player 14	13	9	0.290343724	0.094565			11	3
17		Player 15	1	1	0.168101174	0.895886			12	7
18		Player 16	2	7	0.254289374	0.260977			13	18
19	1	Player 17	1	1	0.96448565	0.021962			14	5
20		Player 18	13	9	0.511317674	0.144665
21		Player 19	8	2	0.233841299	0.779062
22		Player 20	12	4	0.400796127	0.563879
23		Player 21	8	2	0.163515733	0.801686
24		Player 22	11	8	0.103076188	0.151359
25		Player 23	10	3	0.954418397	0.605264
26		Player 24	4	6	0.53847896	0.533054
27		Player 25	6	5	0.811645324	0.544648
28		Player 26	13	9	0.819919282	0.057422
29		Player 27	2	7	0.599897771	0.175729
30		Player 28	8	2	0.286159423	0.788707
31		Player 29	9	10	0.162001563	0.025451
32		Player 30	9	10	0.186465876	0.053017
33		Player 31	6	5	0.463560153	0.53648
34		Player 32	1	1	0.997163941	0.864358
35		Player 33	12	4	0.191912993	0.560422
36		Player 34	2	7	0.559539758	0.28677
37		Player 35	9	10	0.502281051	0.028894
38		Player 36	2	7	0.504587186	0.305232
39		Player 37	12	4	0.783325766	0.591905
40		Player 38	10	3	0.522551286	0.618142
41		Player 39	6	5	0.729153057	0.540354
42		Player 40	4	6	0.120529306	0.400991
Sheet3

Cell Formulas
Range	Formula
C3:C42	C3	=VLOOKUP([@Group],Hole_Assignment,2)
D3:D42	D3	=LET(x,[Non RandomCard],f,FILTER(x*$J$3,x<>""),tr,ROWS(x),r,ROWS(f),s,f-MMULT((f=TRANSPOSE(f))*(SEQUENCE(r)>=SEQUENCE(,r)),SEQUENCE(r,,,0))+1,IF([@[Non RandomCard]]<>"",[@[Non RandomCard]],INDEX(FILTER(INT(SEQUENCE(tr,,,1/$J$3)),ISNA(MATCH(SEQUENCE(tr),s,0))),XMATCH([@Static],SORT(FILTER([Static],x=""),,-1),0))))
E3:E42	E3	=RAND()

Named Ranges
Name	Refers To	Cells
Hole_Assignment	=Sheet3!$I$5:$J$19	C3:C42

 

[BSALV]

i added additional explanation in the macro in previous link.

 

[paulgunther]

Thanks Fluff,
I am definitely more familiar with formulas then VBA. This comes very close, but my goal is to match the "Start" column not the "group" column which gets very tricky since that value is determined by the lookup table of the variable in question. I hope that makes sense.


@BSALV : Thanks to you as well. Pardon my ignorance, but where do I put this code and how do I assign it as a Macro?

 

[Fluff]

Do you mean that the "Non RandomCard" is the "Assigned Hole" & not the "Card"?

 

[Fluff]

If the answer to my question is yes, then try

Fluff.xlsm
	A	B	C	D	E	F	G	H	I	J
1			13	9
2	Non RandomCard	Player	Start	Group	Random	Static
3		Player 1	4	6	0.90463892	0.5058647			Card Size	4
4	8	Player 2	8		0.07266469	0.47407113
5		Player 3	9	10	0.2842961	0.01100784			Card	Assigned Hole
6		Player 4	4	6	0.04777983	0.44786082			1	1
7		Player 5	11	8	0.0379495	0.14991548			2	8
8	8	Player 6	8		0.44358799	0.23506583			3	10
9		Player 7	12	4	0.84420899	0.56262691			4	12
10		Player 8	10	3	0.52830569	0.68880502			5	6
11		Player 9	8	2	0.22943024	0.76699758			6	4
12		Player 10	6	5	0.44664754	0.54427856			7	2
13	13	Player 11	13		0.0910549	0.3125385			8	11
14		Player 12	10	3	0.92814033	0.74561371			9	13
15		Player 13	11	8	0.90059653	0.12112482			10	9
16		Player 14	13	9	0.92399298	0.09456506			11	3
17		Player 15	1	1	0.66979867	0.89588577			12	7
18		Player 16	2	7	0.51023561	0.26097715			13	18
19	13	Player 17	13		0.98196214	0.02196248			14	5
20		Player 18	11	8	0.1725343	0.14466525
21		Player 19	8	2	0.20536583	0.77906214
22		Player 20	12	4	0.05712388	0.56387949
23		Player 21	1	1	0.76803845	0.80168604
24		Player 22	11	8	0.28855994	0.15135902
25		Player 23	10	3	0.40405854	0.60526428
26		Player 24	4	6	0.48563144	0.53305447
27		Player 25	6	5	0.71070956	0.54464767
28		Player 26	13	9	0.77737174	0.05742175
29		Player 27	2	7	0.2715648	0.17572865
30		Player 28	1	1	0.19691226	0.78870732
31		Player 29	9	10	0.33175266	0.02545128
32		Player 30	9	10	0.86714529	0.05301655
33		Player 31	6	5	0.00324294	0.53647952
34		Player 32	1	1	0.79209795	0.86435832
35		Player 33	12	4	0.72879955	0.56042211
36		Player 34	2	7	0.74150056	0.2867701
37		Player 35	9	10	0.08409775	0.02889428
38		Player 36	2	7	0.75323017	0.30523173
39		Player 37	12	4	0.29446306	0.591905
40		Player 38	10	3	0.97609222	0.61814166
41		Player 39	6	5	0.9750985	0.54035428
42		Player 40	4	6	0.65712512	0.40099069
Original

Cell Formulas
Range	Formula
C3:C42	C3	=IF([@[Non RandomCard]]<>"",[@[Non RandomCard]],VLOOKUP([@Group],Hole_Assignment,2))
D3:D42	D3	=LET(x,[Non RandomCard],y,INDEX(Card,MATCH(x,Assigned_Hole,0)),f,FILTER(y*$J$3,ISNUMBER(y)),tr,ROWS(x),r,ROWS(f),s,f-MMULT((f=TRANSPOSE(f))*(SEQUENCE(r)>=SEQUENCE(,r)),SEQUENCE(r,,,0))+1,IF([@[Non RandomCard]]<>"","",INDEX(FILTER(INT(SEQUENCE(tr,,,1/$J$3)),ISNA(MATCH(SEQUENCE(tr),s,0))),XMATCH([@Static],SORT(FILTER([Static],x=""),,-1),0))))
E3:E42	E3	=RAND()

Named Ranges
Name	Refers To	Cells
Assigned_Hole	=Original!$J$6:$J$19	C3:D42
Card	=Original!$I$6:$I$19	C3:D42
Hole_Assignment	=Original!$I$6:$J$19	C3:D42