Lucky draw

[Kitri]

Hi there,
I was assigned a task about lucky draw with conditions and arrangement as follow :
1. There will be 100 employees and 5 prizes
2. Prize will be split into 5 categories :
a. 1st draw : 50 employees with nominal prize ($100/each)
b. 2nd draw : 25 employees with nominal prize ($200/each)
c. 3rd draw : 15 employees with nominal prize ($300/each)
d. 4th draw : 8 employees with nominal prize ($400/each)
e. 5th draw : 2 employees with nominal prize ($500/each)

Need your kind advise on this task since I’m quite new on learning vba.

Thank you in advance

 

[Kitri]

Aha! So let me try Rephrase V2.

1) You have 100 employees.
2) You want to generate a random list of 50 of those employee names. They will all receive $100.
3) You then want to generate a random list of 25 employees of the 50 remaining employees. They will all receive $200.
4) You then want to generate a random list of 15 employees of the 25 remaining employees. They will all receive $300.
5) You then want to generate a random list of 8 employees of the 10 remaining employees. They will all receive $400.
6) Last drawing is pointless because there are only 2 employees left that will receive $500 each.

That all correct?

Yes..correct..
Sorry for unclear information.

Need your advise on it
Thankyou very much

 

[Kitri]

Aha! So let me try Rephrase V2.

1) You have 100 employees.
2) You want to generate a random list of 50 of those employee names. They will all receive $100.
3) You then want to generate a random list of 25 employees of the 50 remaining employees. They will all receive $200.
4) You then want to generate a random list of 15 employees of the 25 remaining employees. They will all receive $300.
5) You then want to generate a random list of 8 employees of the 10 remaining employees. They will all receive $400.
6) Last drawing is pointless because there are only 2 employees left that will receive $500 each.

That all correct?

One more question. Where is your list of employee names? What sheet name and what address range?

Lucky Draw v4.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	No	Name		Prize		Faakhira
2	1	Aatifa		$ 500		Naditya
3	2	Abida		$ 400		Luisa
4	3	Beatarisa		$ 300		Daniza
5	4	Caera		$ 200		Kaila
6	5	Daniza		$ 100		Erina
7	6	Elaina				Calandra
8	7	Fadhila				Baahirah
9	8	Cassia				Qanshana
10	9	Abila				Elvaretta
11	10	Alsava				Aazkiya
12	11	Davidya				Kanaya
13	12	Faiha				Davidya
14	13	Baahirah				Kalya
15	14	Abia				Lanakila
16	15	Danita				Luna
17	16	Desi				Badriyyah
18	17	Elvaretta				Cassia
19	18	Ababil				Ermina
20	19	Badriyyah				Elaina
21	20	Denta				Abia
22	21	Calya				Cassaundra
23	22	Barsha				Querida
24	23	Eisha				Faiha
25	24	Fahimah				Carabella
26	25	Faakhira				Desi
27	26	Davina				Beatarisa
28	27	Carabella				Fairuz
29	28	Darria				Danita
30	29	Bahzy				Qaila
31	30	Aathifa				Basmah
32	31	Cassaundra				Bayuni
33	32	Cadenza				Davina
34	33	Ceisya				Kalila
35	34	Basmah				Chalinda
36	35	Daryan				Alexzandra
37	36	Chalinda				Oceana
38	37	Adira				Abdilla
39	38	Edrea				Edrea
40	39	Beril				Lesya
41	40	Bayuni				Caera
42	41	Daniza				Kania
43	42	Desi				Namira
44	43	Badriyyah				Casia
45	44	Danita				Nadira
46	45	Faihah				Qiandra
47	46	Fairuz				Ceisya
48	47	Beatarisa				Darria
49	48	Eshal				Denta
50	49	Erina
51	50	Calandra
52	51	Davidya
53	52	Casia
54	53	Abia
55	54	Faiha
56	55	Alexzandra
57	56	Denta
58	57	Ababil
59	58	Ermina
60	59	Aazkiya
61	60	Abdilla
62	61	Faiha
63	62	Faihah
64	63	Kaila
65	64	Kalila
66	65	Kalya
67	66	Kamala
68	67	Kamaniai
69	68	Kanaya
70	69	Kania
71	70	Kanisha
72	71	Kanti
73	72	Kanzia
74	73	Laila
75	74	Lanakila
76	75	Lavina
77	76	Lesya
78	77	Luisa
79	78	Luna
80	79	Naava
81	80	Nadira
82	81	Naditya
83	82	Nafiza
84	83	Naifa
85	84	Nailazaara
86	85	Namira
87	86	Nandita
88	87	Nara
89	88	Naraya
90	89	Oceana
91	90	Oksana
92	91	Omkara
93	92	Opaline
94	93	Ophelia
95	94	Oriana
96	95	Qaila
97	96	Qaissara
98	97	Qanshana
99	98	Qeiza
100	99	Qiandra
101	100	Querida
Data

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B2:B41	Cell Value	duplicates	text	NO
B2:B21	Cell Value	duplicates	text	NO
A2:A101	Cell Value	duplicates	text	NO
A2:A101	Cell Value	duplicates	text	NO
G1:G33,G94:G1048576	Cell Value	duplicates	text	NO
G1:G13,G94:G1048576	Cell Value	duplicates	text	NO
F:F	Cell Value	duplicates	text	NO

 

[Eric W]

I took your original sheet, and added a RAND() formula in column C, and I added some Conditional Formatting to show the prize ranges:

Book1
	A	B	C	D	E	F
1	No	Name		Prize	Count	cumulative count
2	1	Aatifa	0.34298171	100	50	0
3	2	Abida	0.54097999	200	25	50
4	3	Beatarisa	0.22724588	300	15	75
5	4	Caera	0.9252929	400	8	90
6	5	Daniza	0.90906489	500	2	98
7	6	Elaina	0.69760485
8	7	Fadhila	0.41560432
9	8	Cassia	0.00096727
10	9	Abila	0.84453264
11	10	Alsava	0.29367193
12	11	Davidya	0.2817714
13	12	Faiha	0.57428575
14	13	Baahirah	0.8134641
15	14	Abia	0.5835496
16	15	Danita	0.95712484
17	16	Desi	0.54401229
18	17	Elvaretta	0.85008631
19	18	Ababil	0.56265351
20	19	Badriyyah	0.62274343
21	20	Denta	0.92668269
22	21	Calya	0.92624384
23	22	Barsha	0.23817511
24	23	Eisha	0.34507431
25	24	Fahimah	0.37351632
26	25	Faakhira	0.68939205
27	26	Davina	0.29212251
28	27	Carabella	0.82123661
29	28	Darria	0.63145938
30	29	Bahzy	0.11834371
31	30	Aathifa	0.13322738
32	31	Cassaundra	0.64894095
33	32	Cadenza	0.40876986
34	33	Ceisya	0.85777725
35	34	Basmah	0.89335751
36	35	Daryan	0.46910052
37	36	Chalinda	0.96967176
38	37	Adira	0.4908153
39	38	Edrea	0.5982872
40	39	Beril	0.52343243
41	40	Bayuni	0.35717182
42	41	Daniza	0.26052914
43	42	Desi	0.40836032
44	43	Badriyyah	0.78798695
45	44	Danita	0.36046969
46	45	Faihah	0.61727093
47	46	Fairuz	0.31567974
48	47	Beatarisa	0.41612788
49	48	Eshal	0.28420766
50	49	Erina	0.05504288
51	50	Calandra	0.8082805
52	51	Davidya	0.74922074
53	52	Casia	0.83507641
54	53	Abia	0.45562655
55	54	Faiha	0.04486417
56	55	Alexzandra	0.84453445
57	56	Denta	0.85305012
58	57	Ababil	0.66637342
59	58	Ermina	0.70814812
60	59	Aazkiya	0.12043527
61	60	Abdilla	0.39724514
62	61	Faiha	0.61708386
63	62	Faihah	0.91118791
64	63	Kaila	0.3035328
65	64	Kalila	0.93519161
66	65	Kalya	0.49681569
67	66	Kamala	0.90402001
68	67	Kamaniai	0.26190232
69	68	Kanaya	0.30384547
70	69	Kania	0.22520539
71	70	Kanisha	0.82071755
72	71	Kanti	0.98926113
73	72	Kanzia	0.27276425
74	73	Laila	0.79415256
75	74	Lanakila	0.40354201
76	75	Lavina	0.46230847
77	76	Lesya	0.1004042
78	77	Luisa	0.28978664
79	78	Luna	0.17665188
80	79	Naava	0.09784831
81	80	Nadira	0.44786347
82	81	Naditya	0.82013238
83	82	Nafiza	0.45722878
84	83	Naifa	0.99822482
85	84	Nailazaara	0.97544601
86	85	Namira	0.36988327
87	86	Nandita	0.28768657
88	87	Nara	0.30462204
89	88	Naraya	0.13447245
90	89	Oceana	0.81782011
91	90	Oksana	0.27120957
92	91	Omkara	0.44610259
93	92	Opaline	0.59400942
94	93	Ophelia	0.15023607
95	94	Oriana	0.25260356
96	95	Qaila	0.11797867
97	96	Qaissara	0.50075873
98	97	Qanshana	0.66158651
99	98	Qeiza	0.00619509
100	99	Qiandra	0.71265379
101	100	Querida	0.22639586
102
Sheet1

Cell Formulas
Range	Formula
C2:C101	C2	=RAND()

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B:B	Expression	=MATCH(ROW()-2,$F$2:$F$6)=5	text	NO
B:B	Expression	=MATCH(ROW()-2,$F$2:$F$6)=4	text	NO
B:B	Expression	=MATCH(ROW()-2,$F$2:$F$6)=3	text	NO
B:B	Expression	=MATCH(ROW()-2,$F$2:$F$6)=2	text	NO
B:B	Expression	=MATCH(ROW()-2,$F$2:$F$6)=1	text	NO

Once you have it set up like this, just select columns B:C, click Sort & Filter > Custom Sort > Sort by > Column C. It will sort the names randomly, and color code each group.

 

[johnnyL]

Ok, here is what I whipped up for a VBA code solution:

Example results:

PSpenceV1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	No	Name		Prize		# of $100 Prize Winners	Employee Name		# of $200 Prize Winners	Employee Name		# of $300 Prize Winners	Employee Name		# of $400 Prize Winners	Employee Name		# of $500 Prize Winners	Employee Name
2	1	Aatifa		500		1	Querida		1	Namira		1	Abdilla		1	Elaina		1	Calya
3	2	Abida		400		2	Cassia		2	Beatarisa		2	Kamaniai		2	Erina		2	Faiha
4	3	Beatarisa		300		3	Aatifa		3	Oksana		3	Faakhira		3	Casia
5	4	Caera		200		4	Chalinda		4	Alsava		4	Davidya		4	Abida
6	5	Daniza		100		5	Bayuni		5	Nailazaara		5	Omkara		5	Lavina
7	6	Elaina				6	Alexzandra		6	Nara		6	Beril		6	Kaila
8	7	Fadhila				7	Kalila		7	Basmah		7	Kanaya		7	Kanisha
9	8	Cassia				8	Eshal		8	Caera		8	Opaline		8	Adira
10	9	Abila				9	Qeiza		9	Aazkiya		9	Denta
11	10	Alsava				10	Desi		10	Abia		10	Daryan
12	11	Davidya				11	Aathifa		11	Naava		11	Kanti
13	12	Faiha				12	Qaila		12	Qanshana		12	Daniza
14	13	Baahirah				13	Beatarisa		13	Edrea		13	Davina
15	14	Abia				14	Luna		14	Lanakila		14	Elvaretta
16	15	Danita				15	Laila		15	Nadira		15	Ophelia
17	16	Desi				16	Kamala		16	Ababil
18	17	Elvaretta				17	Cassaundra		17	Danita
19	18	Ababil				18	Fairuz		18	Desi
20	19	Badriyyah				19	Ceisya		19	Nafiza
21	20	Denta				20	Badriyyah		20	Qiandra
22	21	Calya				21	Eisha		21	Naditya
23	22	Barsha				22	Daniza		22	Oceana
24	23	Eisha				23	Badriyyah		23	Cadenza
25	24	Fahimah				24	Abila		24	Kalya
26	25	Faakhira				25	Faihah		25	Lesya
27	26	Davina				26	Davidya
28	27	Carabella				27	Barsha
29	28	Darria				28	Baahirah
30	29	Bahzy				29	Bahzy
31	30	Aathifa				30	Qaissara
32	31	Cassaundra				31	Nandita
33	32	Cadenza				32	Faiha
34	33	Ceisya				33	Denta
35	34	Basmah				34	Abia
36	35	Daryan				35	Carabella
37	36	Chalinda				36	Naifa
38	37	Adira				37	Faihah
39	38	Edrea				38	Luisa
40	39	Beril				39	Ermina
41	40	Bayuni				40	Darria
42	41	Daniza				41	Kania
43	42	Desi				42	Naraya
44	43	Badriyyah				43	Calandra
45	44	Danita				44	Fadhila
46	45	Faihah				45	Oriana
47	46	Fairuz				46	Danita
48	47	Beatarisa				47	Faiha
49	48	Eshal				48	Fahimah
50	49	Erina				49	Ababil
51	50	Calandra				50	Kanzia
52	51	Davidya
53	52	Casia
54	53	Abia
55	54	Faiha
56	55	Alexzandra
57	56	Denta
58	57	Ababil
59	58	Ermina
60	59	Aazkiya
61	60	Abdilla
62	61	Faiha
63	62	Faihah
64	63	Kaila
65	64	Kalila
66	65	Kalya
67	66	Kamala
68	67	Kamaniai
69	68	Kanaya
70	69	Kania
71	70	Kanisha
72	71	Kanti
73	72	Kanzia
74	73	Laila
75	74	Lanakila
76	75	Lavina
77	76	Lesya
78	77	Luisa
79	78	Luna
80	79	Naava
81	80	Nadira
82	81	Naditya
83	82	Nafiza
84	83	Naifa
85	84	Nailazaara
86	85	Namira
87	86	Nandita
88	87	Nara
89	88	Naraya
90	89	Oceana
91	90	Oksana
92	91	Omkara
93	92	Opaline
94	93	Ophelia
95	94	Oriana
96	95	Qaila
97	96	Qaissara
98	97	Qanshana
99	98	Qeiza
100	99	Qiandra
101	100	Querida
102
Sheet4

VBA macro code to be placed into a separate module and then ran:

Sub Name_Prize_GeneratorV1()
'
    Dim LastRow                             As Long
    Dim RandomEmployeeNumberPicked          As Long, RandomEmployeeNumberPickedCounter  As Long, RandomNumberGeneratedCounter   As Long
    Dim RandomEmployeeNumberPickedArray     As Object
    Dim EmployeeArray                       As Variant
    Dim wsSource                            As Worksheet
'
    Set wsSource = Sheets("Sheet4")                                                     ' <--- Set this to the sheet name that contains the employee list
'
    LastRow = wsSource.Range("B" & Rows.Count).End(xlUp).Row                            ' Get Last Row Number of employee names
'
    EmployeeArray = wsSource.Range("B2:B" & LastRow)                                    ' Load Employee names into a 2D 1 based array RC
'
    Set RandomEmployeeNumberPickedArray = CreateObject("Scripting.Dictionary")          ' Establish Dictionary Array
'
    RandomEmployeeNumberPickedCounter = 1                                               ' Initialize RandomEmployeeNumberPickedCounter
'
'
'   '-----------------------------'
'   ' Generate the random numbers '
'   '-----------------------------'
'
    While RandomEmployeeNumberPickedArray.Count < 100                                   ' Establish loop to generate 100 unique random numbers ... 1 to 100
        RandomEmployeeNumberPicked = Application.WorksheetFunction.RandBetween(1, 100)  '   Generate random number between 1 & 100
'
        If Not RandomEmployeeNumberPickedArray.Exists(RandomEmployeeNumberPicked) Then  '   If this is a unique random # then ...
            RandomEmployeeNumberPickedArray.Add RandomEmployeeNumberPicked, RandomEmployeeNumberPickedCounter   '       Save the number into dictionary array
            RandomEmployeeNumberPickedCounter = RandomEmployeeNumberPickedCounter + 1   '       Increment the RandomEmployeeNumberPickedCounter
        End If
    Wend                                                                                ' Loop back
'
'
'   '-----------------------------'
'   ' Display Drawing # 1 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 50                                          ' Establish loop to loop through first 50 #s randomly generated
        wsSource.Range("F" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 50
'
'       Display associated names to those random #s generated
        wsSource.Range("G" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter - 1), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 2 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 25                                          ' Establish loop to loop through next 25 #s randomly generated
        wsSource.Range("I" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 25
'
'       Display associated names to those random #s generated
        wsSource.Range("j" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 49), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 3 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 15                                          ' Establish loop to loop through next 15 #s randomly generated
        wsSource.Range("L" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 15
'
'       Display associated names to those random #s generated
        wsSource.Range("M" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 74), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 4 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 8                                           ' Establish loop to loop through next 8 #s randomly generated
        wsSource.Range("O" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 8
'
'       Display associated names to those random #s generated
        wsSource.Range("P" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 89), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 5 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 2                                           ' Establish loop to loop through last 2 #s randomly generated
        wsSource.Range("R" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 2
'
'       Display associated names to those random #s generated
        wsSource.Range("S" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 97), 1)
    Next                                                                                ' Loop Back
End Sub

 

[Kitri]

Sub Name_Prize_GeneratorV1() ' Dim LastRow As Long Dim RandomEmployeeNumberPicked As Long, RandomEmployeeNumberPickedCounter As Long, RandomNumberGeneratedCounter As Long Dim RandomEmployeeNumberPickedArray As Object Dim EmployeeArray As Variant Dim wsSource As Worksheet ' Set wsSource = Sheets("Sheet4") ' <--- Set this to the sheet name that contains the employee list ' LastRow = wsSource.Range("B" & Rows.Count).End(xlUp).Row ' Get Last Row Number of employee names ' EmployeeArray = wsSource.Range("B2:B" & LastRow) ' Load Employee names into a 2D 1 based array RC ' Set RandomEmployeeNumberPickedArray = CreateObject("Scripting.Dictionary") ' Establish Dictionary Array ' RandomEmployeeNumberPickedCounter = 1 ' Initialize RandomEmployeeNumberPickedCounter ' ' ' '-----------------------------' ' ' Generate the random numbers ' ' '-----------------------------' ' While RandomEmployeeNumberPickedArray.Count < 100 ' Establish loop to generate 100 unique random numbers ... 1 to 100 RandomEmployeeNumberPicked = Application.WorksheetFunction.RandBetween(1, 100) ' Generate random number between 1 & 100 ' If Not RandomEmployeeNumberPickedArray.Exists(RandomEmployeeNumberPicked) Then ' If this is a unique random # then ... RandomEmployeeNumberPickedArray.Add RandomEmployeeNumberPicked, RandomEmployeeNumberPickedCounter ' Save the number into dictionary array RandomEmployeeNumberPickedCounter = RandomEmployeeNumberPickedCounter + 1 ' Increment the RandomEmployeeNumberPickedCounter End If Wend ' Loop back ' ' ' '-----------------------------' ' ' Display Drawing # 1 Results ' ' '-----------------------------' ' For RandomNumberGeneratedCounter = 1 To 50 ' Establish loop to loop through first 50 #s randomly generated wsSource.Range("F" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter ' Display counter of 1 - 50 ' ' Display associated names to those random #s generated wsSource.Range("G" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter - 1), 1) Next ' Loop Back ' ' ' '-----------------------------' ' ' Display Drawing # 2 Results ' ' '-----------------------------' ' For RandomNumberGeneratedCounter = 1 To 25 ' Establish loop to loop through next 25 #s randomly generated wsSource.Range("I" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter ' Display counter of 1 - 25 ' ' Display associated names to those random #s generated wsSource.Range("j" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 49), 1) Next ' Loop Back ' ' ' '-----------------------------' ' ' Display Drawing # 3 Results ' ' '-----------------------------' ' For RandomNumberGeneratedCounter = 1 To 15 ' Establish loop to loop through next 15 #s randomly generated wsSource.Range("L" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter ' Display counter of 1 - 15 ' ' Display associated names to those random #s generated wsSource.Range("M" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 74), 1) Next ' Loop Back ' ' ' '-----------------------------' ' ' Display Drawing # 4 Results ' ' '-----------------------------' ' For RandomNumberGeneratedCounter = 1 To 8 ' Establish loop to loop through next 8 #s randomly generated wsSource.Range("O" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter ' Display counter of 1 - 8 ' ' Display associated names to those random #s generated wsSource.Range("P" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 89), 1) Next ' Loop Back ' ' ' '-----------------------------' ' ' Display Drawing # 5 Results ' ' '-----------------------------' ' For RandomNumberGeneratedCounter = 1 To 2 ' Establish loop to loop through last 2 #s randomly generated wsSource.Range("R" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter ' Display counter of 1 - 2 ' ' Display associated names to those random #s generated wsSource.Range("S" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 97), 1) Next ' Loop Back End Sub

Hi,

thank you for the macro. it works but i found a duplicate name.

Lucky Draw v4.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	No	Name		Prize		$100			$200			$300			$400			$500
2	1	Aatifa		$ 500		1	Kanisha		1	Ermina		1	Cassia		1	Naifa		1	Lesya
3	2	Abida		$ 400		2	Qeiza		2	Fadhila		2	Daryan		2	Nadira		2	Luisa
4	3	Beatarisa		$ 300		3	Abia		3	Calya		3	Querida		3	Fahimah
5	4	Caera		$ 200		4	Naditya		4	Desi		4	Bahzy		4	Lavina
6	5	Daniza		$ 100		5	Chalinda		5	Kania		5	Kanaya		5	Kalya
7	6	Elaina				6	Qiandra		6	Davidya		6	Kanzia		6	Ababil
8	7	Fadhila				7	Naava		7	Aatifa		7	Kaila		7	Faiha
9	8	Cassia				8	Alexzandra		8	Eshal		8	Elaina		8	Faiha
10	9	Abila				9	Luna		9	Kalila		9	Faiha
11	10	Alsava				10	Nafiza		10	Faakhira		10	Daniza
12	11	Davidya				11	Fairuz		11	Ceisya		11	Nandita
13	12	Faiha				12	Nara		12	Casia		12	Kamala
14	13	Baahirah				13	Ababil		13	Beatarisa		13	Abia
15	14	Abia				14	Faihah		14	Carabella		14	Namira
16	15	Danita				15	Qaissara		15	Alsava		15	Denta
17	16	Desi				16	Beril		16	Nailazaara
18	17	Elvaretta				17	Darria		17	Abila
19	18	Ababil				18	Qanshana		18	Caera
20	19	Badriyyah				19	Omkara		19	Desi
21	20	Denta				20	Kamaniai		20	Oksana
22	21	Calya				21	Cassaundra		21	Kanti
23	22	Barsha				22	Calandra		22	Abida
24	23	Eisha				23	Basmah		23	Davina
25	24	Fahimah				24	Opaline		24	Beatarisa
26	25	Faakhira				25	Badriyyah		25	Cadenza
27	26	Davina				26	Qaila
28	27	Carabella				27	Aazkiya
29	28	Darria				28	Danita
30	29	Bahzy				29	Abdilla
31	30	Aathifa				30	Eisha
32	31	Cassaundra				31	Adira
33	32	Cadenza				32	Aathifa
34	33	Ceisya				33	Denta
35	34	Basmah				34	Bayuni
36	35	Daryan				35	Naraya
37	36	Chalinda				36	Baahirah
38	37	Adira				37	Oriana
39	38	Edrea				38	Barsha
40	39	Beril				39	Badriyyah
41	40	Bayuni				40	Elvaretta
42	41	Daniza				41	Daniza
43	42	Desi				42	Erina
44	43	Badriyyah				43	Faihah
45	44	Danita				44	Ophelia
46	45	Faihah				45	Danita
47	46	Fairuz				46	Edrea
48	47	Beatarisa				47	Lanakila
49	48	Eshal				48	Davidya
50	49	Erina				49	Oceana
51	50	Calandra				50	Laila
52	51	Davidya
53	52	Casia
54	53	Abia
55	54	Faiha
56	55	Alexzandra
57	56	Denta
58	57	Ababil
59	58	Ermina
60	59	Aazkiya
61	60	Abdilla
62	61	Faiha
63	62	Faihah
64	63	Kaila
65	64	Kalila
66	65	Kalya
67	66	Kamala
68	67	Kamaniai
69	68	Kanaya
70	69	Kania
71	70	Kanisha
72	71	Kanti
73	72	Kanzia
74	73	Laila
75	74	Lanakila
76	75	Lavina
77	76	Lesya
78	77	Luisa
79	78	Luna
80	79	Naava
81	80	Nadira
82	81	Naditya
83	82	Nafiza
84	83	Naifa
85	84	Nailazaara
86	85	Namira
87	86	Nandita
88	87	Nara
89	88	Naraya
90	89	Oceana
91	90	Oksana
92	91	Omkara
93	92	Opaline
94	93	Ophelia
95	94	Oriana
96	95	Qaila
97	96	Qaissara
98	97	Qanshana
99	98	Qeiza
100	99	Qiandra
101	100	Querida
Data

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
P2:P1048576	Cell Value	duplicates	text	NO
M2:M1048576	Cell Value	duplicates	text	NO
J2:J1048576	Cell Value	duplicates	text	NO
G2:G1048576	Cell Value	duplicates	text	NO
B2:B41	Cell Value	duplicates	text	NO
B2:B21	Cell Value	duplicates	text	NO
A2:A101	Cell Value	duplicates	text	NO
A2:A101	Cell Value	duplicates	text	NO
G2:G33,G94:G1048576	Cell Value	duplicates	text	NO
G2:G13,G94:G1048576	Cell Value	duplicates	text	NO

Ok, here is what I whipped up for a VBA code solution:

Example results:

PSpenceV1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	No	Name		Prize		# of $100 Prize Winners	Employee Name		# of $200 Prize Winners	Employee Name		# of $300 Prize Winners	Employee Name		# of $400 Prize Winners	Employee Name		# of $500 Prize Winners	Employee Name
2	1	Aatifa		500		1	Querida		1	Namira		1	Abdilla		1	Elaina		1	Calya
3	2	Abida		400		2	Cassia		2	Beatarisa		2	Kamaniai		2	Erina		2	Faiha
4	3	Beatarisa		300		3	Aatifa		3	Oksana		3	Faakhira		3	Casia
5	4	Caera		200		4	Chalinda		4	Alsava		4	Davidya		4	Abida
6	5	Daniza		100		5	Bayuni		5	Nailazaara		5	Omkara		5	Lavina
7	6	Elaina				6	Alexzandra		6	Nara		6	Beril		6	Kaila
8	7	Fadhila				7	Kalila		7	Basmah		7	Kanaya		7	Kanisha
9	8	Cassia				8	Eshal		8	Caera		8	Opaline		8	Adira
10	9	Abila				9	Qeiza		9	Aazkiya		9	Denta
11	10	Alsava				10	Desi		10	Abia		10	Daryan
12	11	Davidya				11	Aathifa		11	Naava		11	Kanti
13	12	Faiha				12	Qaila		12	Qanshana		12	Daniza
14	13	Baahirah				13	Beatarisa		13	Edrea		13	Davina
15	14	Abia				14	Luna		14	Lanakila		14	Elvaretta
16	15	Danita				15	Laila		15	Nadira		15	Ophelia
17	16	Desi				16	Kamala		16	Ababil
18	17	Elvaretta				17	Cassaundra		17	Danita
19	18	Ababil				18	Fairuz		18	Desi
20	19	Badriyyah				19	Ceisya		19	Nafiza
21	20	Denta				20	Badriyyah		20	Qiandra
22	21	Calya				21	Eisha		21	Naditya
23	22	Barsha				22	Daniza		22	Oceana
24	23	Eisha				23	Badriyyah		23	Cadenza
25	24	Fahimah				24	Abila		24	Kalya
26	25	Faakhira				25	Faihah		25	Lesya
27	26	Davina				26	Davidya
28	27	Carabella				27	Barsha
29	28	Darria				28	Baahirah
30	29	Bahzy				29	Bahzy
31	30	Aathifa				30	Qaissara
32	31	Cassaundra				31	Nandita
33	32	Cadenza				32	Faiha
34	33	Ceisya				33	Denta
35	34	Basmah				34	Abia
36	35	Daryan				35	Carabella
37	36	Chalinda				36	Naifa
38	37	Adira				37	Faihah
39	38	Edrea				38	Luisa
40	39	Beril				39	Ermina
41	40	Bayuni				40	Darria
42	41	Daniza				41	Kania
43	42	Desi				42	Naraya
44	43	Badriyyah				43	Calandra
45	44	Danita				44	Fadhila
46	45	Faihah				45	Oriana
47	46	Fairuz				46	Danita
48	47	Beatarisa				47	Faiha
49	48	Eshal				48	Fahimah
50	49	Erina				49	Ababil
51	50	Calandra				50	Kanzia
52	51	Davidya
53	52	Casia
54	53	Abia
55	54	Faiha
56	55	Alexzandra
57	56	Denta
58	57	Ababil
59	58	Ermina
60	59	Aazkiya
61	60	Abdilla
62	61	Faiha
63	62	Faihah
64	63	Kaila
65	64	Kalila
66	65	Kalya
67	66	Kamala
68	67	Kamaniai
69	68	Kanaya
70	69	Kania
71	70	Kanisha
72	71	Kanti
73	72	Kanzia
74	73	Laila
75	74	Lanakila
76	75	Lavina
77	76	Lesya
78	77	Luisa
79	78	Luna
80	79	Naava
81	80	Nadira
82	81	Naditya
83	82	Nafiza
84	83	Naifa
85	84	Nailazaara
86	85	Namira
87	86	Nandita
88	87	Nara
89	88	Naraya
90	89	Oceana
91	90	Oksana
92	91	Omkara
93	92	Opaline
94	93	Ophelia
95	94	Oriana
96	95	Qaila
97	96	Qaissara
98	97	Qanshana
99	98	Qeiza
100	99	Qiandra
101	100	Querida
102
Sheet4

VBA macro code to be placed into a separate module and then ran:

Sub Name_Prize_GeneratorV1()
'
    Dim LastRow                             As Long
    Dim RandomEmployeeNumberPicked          As Long, RandomEmployeeNumberPickedCounter  As Long, RandomNumberGeneratedCounter   As Long
    Dim RandomEmployeeNumberPickedArray     As Object
    Dim EmployeeArray                       As Variant
    Dim wsSource                            As Worksheet
'
    Set wsSource = Sheets("Sheet4")                                                     ' <--- Set this to the sheet name that contains the employee list
'
    LastRow = wsSource.Range("B" & Rows.Count).End(xlUp).Row                            ' Get Last Row Number of employee names
'
    EmployeeArray = wsSource.Range("B2:B" & LastRow)                                    ' Load Employee names into a 2D 1 based array RC
'
    Set RandomEmployeeNumberPickedArray = CreateObject("Scripting.Dictionary")          ' Establish Dictionary Array
'
    RandomEmployeeNumberPickedCounter = 1                                               ' Initialize RandomEmployeeNumberPickedCounter
'
'
'   '-----------------------------'
'   ' Generate the random numbers '
'   '-----------------------------'
'
    While RandomEmployeeNumberPickedArray.Count < 100                                   ' Establish loop to generate 100 unique random numbers ... 1 to 100
        RandomEmployeeNumberPicked = Application.WorksheetFunction.RandBetween(1, 100)  '   Generate random number between 1 & 100
'
        If Not RandomEmployeeNumberPickedArray.Exists(RandomEmployeeNumberPicked) Then  '   If this is a unique random # then ...
            RandomEmployeeNumberPickedArray.Add RandomEmployeeNumberPicked, RandomEmployeeNumberPickedCounter   '       Save the number into dictionary array
            RandomEmployeeNumberPickedCounter = RandomEmployeeNumberPickedCounter + 1   '       Increment the RandomEmployeeNumberPickedCounter
        End If
    Wend                                                                                ' Loop back
'
'
'   '-----------------------------'
'   ' Display Drawing # 1 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 50                                          ' Establish loop to loop through first 50 #s randomly generated
        wsSource.Range("F" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 50
'
'       Display associated names to those random #s generated
        wsSource.Range("G" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter - 1), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 2 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 25                                          ' Establish loop to loop through next 25 #s randomly generated
        wsSource.Range("I" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 25
'
'       Display associated names to those random #s generated
        wsSource.Range("j" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 49), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 3 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 15                                          ' Establish loop to loop through next 15 #s randomly generated
        wsSource.Range("L" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 15
'
'       Display associated names to those random #s generated
        wsSource.Range("M" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 74), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 4 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 8                                           ' Establish loop to loop through next 8 #s randomly generated
        wsSource.Range("O" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 8
'
'       Display associated names to those random #s generated
        wsSource.Range("P" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 89), 1)
    Next                                                                                ' Loop Back
'
'
'   '-----------------------------'
'   ' Display Drawing # 5 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 2                                           ' Establish loop to loop through last 2 #s randomly generated
        wsSource.Range("R" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 2
'
'       Display associated names to those random #s generated
        wsSource.Range("S" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 97), 1)
    Next                                                                                ' Loop Back
End Sub

Hi,

thank you for the solution.
I tried the macro, but it shows duplicate names on each draw (pink column).
And can we draw one by one for each prize, since on your macro it draw at one time for all.

Please advise.Thank you

Lucky Draw v4.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	No	Name		Prize		$100			$200			$300			$400			$500
2	1	Aatifa		$ 500		1	Kanisha		1	Ermina		1	Cassia		1	Naifa		1	Lesya
3	2	Abida		$ 400		2	Qeiza		2	Fadhila		2	Daryan		2	Nadira		2	Luisa
4	3	Beatarisa		$ 300		3	Abia		3	Calya		3	Querida		3	Fahimah
5	4	Caera		$ 200		4	Naditya		4	Desi		4	Bahzy		4	Lavina
6	5	Daniza		$ 100		5	Chalinda		5	Kania		5	Kanaya		5	Kalya
7	6	Elaina				6	Qiandra		6	Davidya		6	Kanzia		6	Ababil
8	7	Fadhila				7	Naava		7	Aatifa		7	Kaila		7	Faiha
9	8	Cassia				8	Alexzandra		8	Eshal		8	Elaina		8	Faiha
10	9	Abila				9	Luna		9	Kalila		9	Faiha
11	10	Alsava				10	Nafiza		10	Faakhira		10	Daniza
12	11	Davidya				11	Fairuz		11	Ceisya		11	Nandita
13	12	Faiha				12	Nara		12	Casia		12	Kamala
14	13	Baahirah				13	Ababil		13	Beatarisa		13	Abia
15	14	Abia				14	Faihah		14	Carabella		14	Namira
16	15	Danita				15	Qaissara		15	Alsava		15	Denta
17	16	Desi				16	Beril		16	Nailazaara
18	17	Elvaretta				17	Darria		17	Abila
19	18	Ababil				18	Qanshana		18	Caera
20	19	Badriyyah				19	Omkara		19	Desi
21	20	Denta				20	Kamaniai		20	Oksana
22	21	Calya				21	Cassaundra		21	Kanti
23	22	Barsha				22	Calandra		22	Abida
24	23	Eisha				23	Basmah		23	Davina
25	24	Fahimah				24	Opaline		24	Beatarisa
26	25	Faakhira				25	Badriyyah		25	Cadenza
27	26	Davina				26	Qaila
28	27	Carabella				27	Aazkiya
29	28	Darria				28	Danita
30	29	Bahzy				29	Abdilla
31	30	Aathifa				30	Eisha
32	31	Cassaundra				31	Adira
33	32	Cadenza				32	Aathifa
34	33	Ceisya				33	Denta
35	34	Basmah				34	Bayuni
36	35	Daryan				35	Naraya
37	36	Chalinda				36	Baahirah
38	37	Adira				37	Oriana
39	38	Edrea				38	Barsha
40	39	Beril				39	Badriyyah
41	40	Bayuni				40	Elvaretta
42	41	Daniza				41	Daniza
43	42	Desi				42	Erina
44	43	Badriyyah				43	Faihah
45	44	Danita				44	Ophelia
46	45	Faihah				45	Danita
47	46	Fairuz				46	Edrea
48	47	Beatarisa				47	Lanakila
49	48	Eshal				48	Davidya
50	49	Erina				49	Oceana
51	50	Calandra				50	Laila
52	51	Davidya
53	52	Casia
54	53	Abia
55	54	Faiha
56	55	Alexzandra
57	56	Denta
58	57	Ababil
59	58	Ermina
60	59	Aazkiya
61	60	Abdilla
62	61	Faiha
63	62	Faihah
64	63	Kaila
65	64	Kalila
66	65	Kalya
67	66	Kamala
68	67	Kamaniai
69	68	Kanaya
70	69	Kania
71	70	Kanisha
72	71	Kanti
73	72	Kanzia
74	73	Laila
75	74	Lanakila
76	75	Lavina
77	76	Lesya
78	77	Luisa
79	78	Luna
80	79	Naava
81	80	Nadira
82	81	Naditya
83	82	Nafiza
84	83	Naifa
85	84	Nailazaara
86	85	Namira
87	86	Nandita
88	87	Nara
89	88	Naraya
90	89	Oceana
91	90	Oksana
92	91	Omkara
93	92	Opaline
94	93	Ophelia
95	94	Oriana
96	95	Qaila
97	96	Qaissara
98	97	Qanshana
99	98	Qeiza
100	99	Qiandra
101	100	Querida
Data

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
P2:P1048576	Cell Value	duplicates	text	NO
M2:M1048576	Cell Value	duplicates	text	NO
J2:J1048576	Cell Value	duplicates	text	NO
G2:G1048576	Cell Value	duplicates	text	NO
B2:B41	Cell Value	duplicates	text	NO
B2:B21	Cell Value	duplicates	text	NO
A2:A101	Cell Value	duplicates	text	NO
A2:A101	Cell Value	duplicates	text	NO
G2:G33,G94:G1048576	Cell Value	duplicates	text	NO
G2:G13,G94:G1048576	Cell Value	duplicates	text	NO

 

[johnnyL]

thank you for the solution.
I tried the macro, but it shows duplicate names on each draw (pink column).

There is a phrase in the computer world of GIGO. It stands for Garbage In Garbage Out.

You are not seeing 'duplicates' in the sense that you are implying. You are seeing different employees with the same name.

Your list of employees is where the 'duplicates' originate from.

Badriyyah   - #19, #43
Beatarisa   - #3,  #47
Danita      - #15, #44
Desi        - #16, #42
Faiha       - #12, #54, #61
Faihah      - #45, #62

I don't believe that it is possible for the code that I provided to produce duplicates, provided that each drawing is chopped up properly, which it is.


Now on to your question. You asked if the code could be done to 'draw one by one for each prize'. I need some clarification there. Are you asking for a separate display for each employee, meaning 100 separate displays? Are you asking for a separate display for each prize category, meaning all of the $100 winners displayed, then $200 winners, etc?

Please clarify what you are asking.

 

[Kitri]

There is a phrase in the computer world of GIGO. It stands for Garbage In Garbage Out.

You are not seeing 'duplicates' in the sense that you are implying. You are seeing different employees with the same name.

Your list of employees is where the 'duplicates' originate from.

Badriyyah   - #19, #43
Beatarisa   - #3,  #47
Danita      - #15, #44
Desi        - #16, #42
Faiha       - #12, #54, #61
Faihah      - #45, #62

I don't believe that it is possible for the code that I provided to produce duplicates, provided that each drawing is chopped up properly, which it is.


Now on to your question. You asked if the code could be done to 'draw one by one for each prize'. I need some clarification there. Are you asking for a separate display for each employee, meaning 100 separate displays? Are you asking for a separate display for each prize category, meaning all of the $100 winners displayed, then $200 winners, etc?

Please clarify what you are asking.

Noted on the duplicate names. My bad not checked the origin data.

I’m asking for separate display for each prize category. All of $100 winners displayed, then $200 winners, etc.

Please advise. Thankyou

 

[johnnyL]

Ok. Try this:

#If VBA7 Then
    Public Declare PtrSafe Function ModelessMsgBox Lib "User32" Alias "MessageBoxA" (Optional ByVal hWnd As Long, _
            Optional ByVal prompt As String, _
            Optional ByVal title As String, _
            Optional ByVal buttons As Long) As Long
#Else
    Public Declare Function ModelessMsgBox Lib "User32" Alias "MessageBoxA" (Optional ByVal hWnd As Long, _
            Optional ByVal prompt As String, _
            Optional ByVal title As String, _
            Optional ByVal buttons As Long) As Long
#End If

Sub Name_Prize_GeneratorV2()
'
    Dim LastRow                             As Long
    Dim RandomEmployeeNumberPicked          As Long, RandomEmployeeNumberPickedCounter  As Long, RandomNumberGeneratedCounter   As Long
    Dim RandomEmployeeNumberPickedArray     As Object
    Dim EmployeeArray                       As Variant
    Dim wsSource                            As Worksheet
'
    Set wsSource = Sheets("Sheet3")                                                     ' <--- Set this to the sheet name that contains the employee list
'
    LastRow = wsSource.Range("B" & Rows.Count).End(xlUp).Row                            ' Get Last Row Number of employee names
'
    EmployeeArray = wsSource.Range("B2:B" & LastRow)                                    ' Load Employee names into a 2D 1 based array RC
'
    Set RandomEmployeeNumberPickedArray = CreateObject("Scripting.Dictionary")          ' Establish Dictionary Array
'
    RandomEmployeeNumberPickedCounter = 1                                               ' Initialize RandomEmployeeNumberPickedCounter
'
    wsSource.Range("F2:S52").ClearContents                                              ' Erase the Results area
'
'
'   '-----------------------------'
'   ' Generate the random numbers '
'   '-----------------------------'
'
    While RandomEmployeeNumberPickedArray.Count < 100                                   ' Establish loop to generate 100 unique random numbers ... 1 to 100
        RandomEmployeeNumberPicked = Application.WorksheetFunction.RandBetween(1, 100)  '   Generate random number between 1 & 100
'
        If Not RandomEmployeeNumberPickedArray.Exists(RandomEmployeeNumberPicked) Then  '   If this is a unique random # then ...
            RandomEmployeeNumberPickedArray.Add RandomEmployeeNumberPicked, RandomEmployeeNumberPickedCounter   '       Save the number into dictionary array
            RandomEmployeeNumberPickedCounter = RandomEmployeeNumberPickedCounter + 1   '       Increment the RandomEmployeeNumberPickedCounter
        End If
    Wend                                                                                ' Loop back
'
'
'   '-----------------------------'
'   ' Display Drawing # 1 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 50                                          ' Establish loop to loop through first 50 #s randomly generated
        wsSource.Range("F" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 50
'
'       Display associated names to those random #s generated
        wsSource.Range("G" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter - 1), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$100 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $200 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 2 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 25                                          ' Establish loop to loop through next 25 #s randomly generated
        wsSource.Range("I" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 25
'
'       Display associated names to those random #s generated
        wsSource.Range("j" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 49), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$200 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $300 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 3 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 15                                          ' Establish loop to loop through next 15 #s randomly generated
        wsSource.Range("L" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 15
'
'       Display associated names to those random #s generated
        wsSource.Range("M" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 74), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$300 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $400 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 4 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 8                                           ' Establish loop to loop through next 8 #s randomly generated
        wsSource.Range("O" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 8
'
'       Display associated names to those random #s generated
        wsSource.Range("P" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 89), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$400 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $500 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 5 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 2                                           ' Establish loop to loop through last 2 #s randomly generated
        wsSource.Range("R" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 2
'
'       Display associated names to those random #s generated
        wsSource.Range("S" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 97), 1)
    Next                                                                                ' Loop Back
End Sub

 

[Kitri]

Ok. Try this:

#If VBA7 Then
    Public Declare PtrSafe Function ModelessMsgBox Lib "User32" Alias "MessageBoxA" (Optional ByVal hWnd As Long, _
            Optional ByVal prompt As String, _
            Optional ByVal title As String, _
            Optional ByVal buttons As Long) As Long
#Else
    Public Declare Function ModelessMsgBox Lib "User32" Alias "MessageBoxA" (Optional ByVal hWnd As Long, _
            Optional ByVal prompt As String, _
            Optional ByVal title As String, _
            Optional ByVal buttons As Long) As Long
#End If

Sub Name_Prize_GeneratorV2()
'
    Dim LastRow                             As Long
    Dim RandomEmployeeNumberPicked          As Long, RandomEmployeeNumberPickedCounter  As Long, RandomNumberGeneratedCounter   As Long
    Dim RandomEmployeeNumberPickedArray     As Object
    Dim EmployeeArray                       As Variant
    Dim wsSource                            As Worksheet
'
    Set wsSource = Sheets("Sheet3")                                                     ' <--- Set this to the sheet name that contains the employee list
'
    LastRow = wsSource.Range("B" & Rows.Count).End(xlUp).Row                            ' Get Last Row Number of employee names
'
    EmployeeArray = wsSource.Range("B2:B" & LastRow)                                    ' Load Employee names into a 2D 1 based array RC
'
    Set RandomEmployeeNumberPickedArray = CreateObject("Scripting.Dictionary")          ' Establish Dictionary Array
'
    RandomEmployeeNumberPickedCounter = 1                                               ' Initialize RandomEmployeeNumberPickedCounter
'
    wsSource.Range("F2:S52").ClearContents                                              ' Erase the Results area
'
'
'   '-----------------------------'
'   ' Generate the random numbers '
'   '-----------------------------'
'
    While RandomEmployeeNumberPickedArray.Count < 100                                   ' Establish loop to generate 100 unique random numbers ... 1 to 100
        RandomEmployeeNumberPicked = Application.WorksheetFunction.RandBetween(1, 100)  '   Generate random number between 1 & 100
'
        If Not RandomEmployeeNumberPickedArray.Exists(RandomEmployeeNumberPicked) Then  '   If this is a unique random # then ...
            RandomEmployeeNumberPickedArray.Add RandomEmployeeNumberPicked, RandomEmployeeNumberPickedCounter   '       Save the number into dictionary array
            RandomEmployeeNumberPickedCounter = RandomEmployeeNumberPickedCounter + 1   '       Increment the RandomEmployeeNumberPickedCounter
        End If
    Wend                                                                                ' Loop back
'
'
'   '-----------------------------'
'   ' Display Drawing # 1 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 50                                          ' Establish loop to loop through first 50 #s randomly generated
        wsSource.Range("F" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 50
'
'       Display associated names to those random #s generated
        wsSource.Range("G" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter - 1), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$100 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $200 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 2 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 25                                          ' Establish loop to loop through next 25 #s randomly generated
        wsSource.Range("I" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 25
'
'       Display associated names to those random #s generated
        wsSource.Range("j" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 49), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$200 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $300 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 3 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 15                                          ' Establish loop to loop through next 15 #s randomly generated
        wsSource.Range("L" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 15
'
'       Display associated names to those random #s generated
        wsSource.Range("M" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 74), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$300 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $400 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 4 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 8                                           ' Establish loop to loop through next 8 #s randomly generated
        wsSource.Range("O" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 8
'
'       Display associated names to those random #s generated
        wsSource.Range("P" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 89), 1)
    Next                                                                                ' Loop Back
'
    For I = 1 To 5                                                                      ' Use a loop to allow time for results to display ... increase if needed
        DoEvents
    Next I
'
    If ModelessMsgBox(prompt:=Space(27) & "$400 Prize winners have have been displayed." & vbCrLf & vbCrLf & "Press the 'OK' button when you " & _
        "are ready to display the $500 prize winners.", title:=Space(33) & "Program paused to allow scrolling.", buttons:=vbOK) <> 1 Then Exit Sub
'
'
'   '-----------------------------'
'   ' Display Drawing # 5 Results '
'   '-----------------------------'
'
    For RandomNumberGeneratedCounter = 1 To 2                                           ' Establish loop to loop through last 2 #s randomly generated
        wsSource.Range("R" & RandomNumberGeneratedCounter + 1).Value = RandomNumberGeneratedCounter '   Display counter of 1 - 2
'
'       Display associated names to those random #s generated
        wsSource.Range("S" & RandomNumberGeneratedCounter + 1).Value = EmployeeArray(RandomEmployeeNumberPickedArray.Keys()(RandomNumberGeneratedCounter + 97), 1)
    Next                                                                                ' Loop Back
End Sub

Hi,

thank you very much for your help.
its works. Perfect

 

[johnnyL]

Glad to help.