VBA random number generator.

[motilulla]

Using Excel 2010
Hello,

I need help it is bit tricky random number generator…

Step1-I want first VBA create a list of numbers 1 to 54 in the range C6:C59.

Step2-Pick 1 random numbers out of list range C6:C59 and list it in cell D6.

Step3-Delete picked random from the list C6:C59 and shift up.

Step-4 repeat the Step-2 and place 2nd random below the Cell D6..and continue till find 20 random numbers…

Here below is the example sheet…showing remaining numbers in column C, 20 random in Column D, also check 54 list result in Column G.

Excel Questions.xlsm
	A	B	C	D	E	F	G	H
1
2
3
4				Pick
5			Numbers List	20 Random		Full List	Count
6			2	1		1	1
7			3	5		2	1
8			4	6		3	1
9			7	10		4	1
10			8	12		5	1
11			9	15		6	1
12			11	20		7	1
13			13	22		8	1
14			14	28		9	1
15			16	36		10	1
16			17	38		11	1
17			18	39		12	1
18			19	41		13	1
19			21	44		14	1
20			23	46		15	1
21			24	47		16	1
22			25	50		17	1
23			26	51		18	1
24			27	52		19	1
25			29	54		20	1
26			30			21	1
27			31			22	1
28			32			23	1
29			33			24	1
30			34			25	1
31			35			26	1
32			37			27	1
33			40			28	1
34			42			29	1
35			43			30	1
36			45			31	1
37			48			32	1
38			49			33	1
39			53			34	1
40						35	1
41						36	1
42						37	1
43						38	1
44						39	1
45						40	1
46						41	1
47						42	1
48						43	1
49						44	1
50						45	1
51						46	1
52						47	1
53						48	1
54						49	1
55						50	1
56						51	1
57						52	1
58						53	1
59						54	1
60
61
Sheet0

Cell Formulas
Range	Formula
G6:G59	G6	=COUNTIF(C$6:D$59,F6)

Regards,
Moti

 

[motilulla]

Hello, again may be I am wrong this cannot be done. My need is to have X unique random numbers list, and also remain list of numbers too from the pool.

This was my thought may it could be done different way I will be happy to get any alternate VBA solution will be good for me.

Regards,
Moti

 

[motilulla]

BUMP

 

[Tupe77]

Do you mean something like this?

Noteworthy.
1. Overwrites the previous result
2. Picks 20 numbers, less numbers left will cause an error
How should these points be handled?

Sub TS_RandomNumbers()
Dim RandomARR(1 To 20, 1 To 1) As Integer
Dim iPick As Integer, NumbersLeft As Integer, iRAND As Integer
Dim coll As New Collection, iC As Integer
Dim NumberListRNG As Range
Dim ws As Worksheet: Set ws = ActiveSheet

Randomize

Set NumberListRNG = ws.Range("C6:C" & ws.Cells(Rows.Count, "C").End(xlUp).Row)

NumbersLeft = NumberListRNG.Cells.Count
For iC = 1 To NumbersLeft
    coll.Add NumberListRNG(iC).Value2
Next iC


For iPick = 1 To 20                     ' Draw 20 times
    iRAND = Int(NumbersLeft * Rnd) + 1  ' Random number
    RandomARR(iPick, 1) = coll(iRAND)   ' Write random number to result array
    coll.Remove (iRAND)                 ' Remove used number
    NumbersLeft = NumbersLeft - 1
Next iPick

' Clear Number List
NumberListRNG.Clear
' ReWrite Number List
Dim iRow As Integer
For iRow = 1 To coll.Count
    NumberListRNG(iRow).Value = coll(iRow)
Next

' Write return values
Range("d6:d25").Value = RandomARR ' Overwrites the previous result
End Sub

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[motilulla]

Do you mean something like this?

Noteworthy.
1. Overwrites the previous result
2. Picks 20 numbers, less numbers left will cause an error
How should these points be handled?
My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

Tupe77, I am glad it is almost perfect as I wanted.

Please I need can you add when the macro runs…..

Step1-clear the range C6:D59

Step2-creat a list in the column C6 to below 54 numbers 1 to 54.

Step3-start your macro this way never will be the less numbers left in the column C always will be 54. Also can you add if error than Exit Sub.

I appreciate your help.

Kind Regards,
Moti

 

[Tupe77]

Is this version closer to the goal?

Sub TS_RandomNumbers()
Dim RandomARR(1 To 20, 1 To 1) As Integer
Dim iPick As Integer, NumbersLeft As Integer, iRAND As Integer, iRow As Integer
Dim coll As New Collection, iC As Integer
Dim NumberListRNG As Range
On Error GoTo ErrHand

Dim ws As Worksheet: Set ws = Worksheets("Sheet0")

Randomize

Set NumberListRNG = ws.Range("C6:C59")  ' Set range

' STEP1 (just for writing all values to sheet but those are never displayed)
For iRow = 1 To 54
    NumberListRNG(iRow).Value2 = iRow   ' Create Numbers list
Next iRow

' Read Numbers list values to Collection
NumbersLeft = 54
For iC = 1 To NumbersLeft
    coll.Add NumberListRNG(iC).Value2
    ' coll.Add iC
Next iC

' Step2-Pick 1 random numbers out of list range C6:C59 and list it in cell D6. & Step3-Delete picked random from the list C6:C59 and shift up.
For iPick = 1 To 20                     ' Draw 20 times
    iRAND = Int(NumbersLeft * Rnd) + 1  ' Random number
    RandomARR(iPick, 1) = coll(iRAND)   ' Write random number to result array (Step2-Pick)
    coll.Remove (iRAND)                 ' Remove used number (Step3-Delete)
    NumbersLeft = NumbersLeft - 1
Next iPick

' Clear Number List
NumberListRNG.Clear                     ' Step3-Delete

' ReWrite Number List
For iRow = 1 To coll.Count
    NumberListRNG(iRow).Value = coll(iRow)
Next

' Write return values (Step2-Pick)
ws.Range("d6:d25").Value2 = RandomARR ' Overwrites the previous result

ErrHand: 
End Sub

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[motilulla]

Is this version closer to the goal?
My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

Tupe77, I am sorry it is my mistake I run on other sheet name, this worked superb.

Also if it is not much random result in column D can be showed in ascending order.

Kind Regards,
Moti

 

[Tupe77]

In this cleaned version, there is no first writing of the numbers 1-54 in the C column at all.
At the end, column C and D are written normally, so the end result looks the same.
Finally, the results of column D are arranged.

Would this be a suitable way to implement a number draw?

Sub TS_RandomNumbers()
Dim RandomARR(1 To 20, 1 To 1) As Integer
Dim coll As New Collection, i As Integer, iRAND As Integer, NumbersLeft As Integer
Dim ws As Worksheet: Set ws = Activesheet
Dim NumberListRNG As Range: Set NumberListRNG = ws.Range("C6:C59"): NumberListRNG.Clear ' Set range

Randomize ' Create new seed

' Write Numbers list values (1 to 54) to Collection
NumbersLeft = 54            ' Index number for Collection
For i = 1 To NumbersLeft
    coll.Add i             ' Add to Collection
Next i

' Step2-Pick 20 random numbers out of list range C6:C59 and list it in cell D6:D25
For i = 1 To 20                     ' Do this 20 times
    iRAND = Int(NumbersLeft * Rnd) + 1  ' Create Random index number
    RandomARR(i, 1) = coll(iRAND)   ' Write number to result array (selected by random index number)
    coll.Remove (iRAND)                 ' Remove used number from Collection
    NumbersLeft = NumbersLeft - 1       ' Fix to Collection lenght
Next i

' Clear Number List
NumberListRNG.Clear

' ReWrite Number List
For i = 1 To coll.Count
    NumberListRNG(i).Value = coll(i)
Next

' Write return values (Step2-Pick)
ws.Range("d6:d25").Value2 = RandomARR ' Overwrites the previous result
ws.Range("d6:d25").Sort Key1:=Range("d5"), Order1:=xlAscending ' Sort range to Ascending
End Sub

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[Tupe77]

The message was deleted because it was intended for another message thread.

 

[motilulla]

In this cleaned version, there is no first writing of the numbers 1-54 in the C column at all.
At the end, column C and D are written normally, so the end result looks the same.
Finally, the results of column D are arranged.

Great Tupe77, this version worked like magic. I am grateful to you being till end and solving as I wanted!

Would this be a suitable way to implement a number draw?

Tupe77, as long as my knowledge lottery draws are totally random and if random fits you are the luckiest person. Just keep trying small amount to get big price there is no more calculations

Have a good day and Good Luck!

Kind Regards,
Moti