Choose from a list "x" random no duplicates

[Kishan]

Using Excel 2000</SPAN></SPAN>
Hi,</SPAN></SPAN>

VBA, which can choose "x random numbers" from a list of column A (list in the column a can be max 290 rows)</SPAN></SPAN>

For example list shown in column A has 28 rows, I want "4 random (no duplicates), which I have placed in cell B1 and result in C2 down </SPAN></SPAN>

Example data</SPAN></SPAN>

Book1
	A	B	C	D
1	List of Numbers	4	Rando Selected
2	0 | 0 | 0 | 0 | 0 | 0 | 2		0 | 0 | 0 | 0 | 2 | 0 | 0
3	0 | 0 | 0 | 0 | 0 | 1 | 1		0 | 0 | 1 | 0 | 0 | 1 | 0
4	0 | 0 | 0 | 0 | 0 | 2 | 0		0 | 1 | 0 | 0 | 0 | 1 | 0
5	0 | 0 | 0 | 0 | 1 | 0 | 1		1 | 1 | 0 | 0 | 0 | 0 | 0
6	0 | 0 | 0 | 0 | 1 | 1 | 0
7	0 | 0 | 0 | 0 | 2 | 0 | 0
8	0 | 0 | 0 | 1 | 0 | 0 | 1
9	0 | 0 | 0 | 1 | 0 | 1 | 0
10	0 | 0 | 0 | 1 | 1 | 0 | 0
11	0 | 0 | 0 | 2 | 0 | 0 | 0
12	0 | 0 | 1 | 0 | 0 | 0 | 1
13	0 | 0 | 1 | 0 | 0 | 1 | 0
14	0 | 0 | 1 | 0 | 1 | 0 | 0
15	0 | 0 | 1 | 1 | 0 | 0 | 0
16	0 | 0 | 2 | 0 | 0 | 0 | 0
17	0 | 1 | 0 | 0 | 0 | 0 | 1
18	0 | 1 | 0 | 0 | 0 | 1 | 0
19	0 | 1 | 0 | 0 | 1 | 0 | 0
20	0 | 1 | 0 | 1 | 0 | 0 | 0
21	0 | 1 | 1 | 0 | 0 | 0 | 0
22	0 | 2 | 0 | 0 | 0 | 0 | 0
23	1 | 0 | 0 | 0 | 0 | 0 | 1
24	1 | 0 | 0 | 0 | 0 | 1 | 0
25	1 | 0 | 0 | 0 | 1 | 0 | 0
26	1 | 0 | 0 | 1 | 0 | 0 | 0
27	1 | 0 | 1 | 0 | 0 | 0 | 0
28	1 | 1 | 0 | 0 | 0 | 0 | 0
29	2 | 0 | 0 | 0 | 0 | 0 | 0
30
31
32
Sheet1

Thank you in advance</SPAN></SPAN>

Regards,</SPAN>
Kishan</SPAN></SPAN>

 

[Kishan]

Yes, I think it won't work in Excel 2000.
Try changing this line:
x = WorksheetFunction.RandBetween(1, UBound(va, 1))
to this:
x = Int((UBound(va, 1)) * Rnd + 1)

Akuini, I am out of town so I do not have access to my desk computer one week, I will check it when I will go back and tell you the results

Thank you, have a nice weekend

Kind Regards
Kishan

 

[Kishan]

Yes, I think it won't work in Excel 2000.
Try changing this line:
x = WorksheetFunction.RandBetween(1, UBound(va, 1))
to this:
x = Int((UBound(va, 1)) * Rnd + 1)

Akuini, it worked perfect!! </SPAN></SPAN>

Thank you very much for your time and help</SPAN></SPAN>

Have a nice weekend</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Akuini]

Akuini, it worked perfect!!

Thank you very much for your time and help

Have a nice weekend

Kind Regards,
Kishan

Actually there's a problem with my code. It doesn't guarantee that we will get 4 random number, it could be below 4. Well, if your data is big, say hundreds of rows, then the possibility to get the result below 4 is very small. But just to make sure that won't happen I modified the code a bit, so use this one instead:

Sub a1075487b()
'https://www.mrexcel.com/forum/excel-questions/1075487-choose-list-x-random-no-duplicates.html
Dim i As Long, x As Long, n As Long, z As Long
Dim d As Object, va

va = Range("A2", Cells(Rows.count, "A").End(xlUp))
Set d = CreateObject("scripting.dictionary")
z = 4  [COLOR=#0000ff]'change this to get different number of result[/COLOR]
If z > UBound(va) Then MsgBox ("Something wrong"): Exit Sub
    Do
    x = Int((UBound(va, 1)) * Rnd + 1)
        If Not d.Exists(va(x, 1)) Then
            n = n + 1
            d(va(x, 1)) = ""
        End If
    Loop Until n = z
    Range("C2").Resize(d.count) = Application.Transpose(d.Keys)
End Sub

 

[Kishan]

Actually there's a problem with my code. It doesn't guarantee that we will get 4 random number, it could be below 4. Well, if your data is big, say hundreds of rows, then the possibility to get the result below 4 is very small. But just to make sure that won't happen I modified the code a bit, so use this one instead:

Sub a1075487b()
'https://www.mrexcel.com/forum/excel-questions/1075487-choose-list-x-random-no-duplicates.html
Dim i As Long, x As Long, n As Long, z As Long
Dim d As Object, va

va = Range("A2", Cells(Rows.count, "A").End(xlUp))
Set d = CreateObject("scripting.dictionary")
z = 4  [COLOR=#0000ff]'change this to get different number of result[/COLOR]
If z > UBound(va) Then MsgBox ("Something wrong"): Exit Sub
    Do
    x = Int((UBound(va, 1)) * Rnd + 1)
        If Not d.Exists(va(x, 1)) Then
            n = n + 1
            d(va(x, 1)) = ""
        End If
    Loop Until n = z
    Range("C2").Resize(d.count) = Application.Transpose(d.Keys)
End Sub

Akuini, yes it correct, apart of that with the older code I found another problem too, say for example I filled data in column A with 266 rows and when I changed "z = 4" to "z = 266" it were generating only 165 random.</SPAN></SPAN>

But with this last modified code it generate 266 Perfectly, and if I changed "z = 267" gives message "Something wrong" now the code is running 100% accurate </SPAN></SPAN>

Thank you Akuini, for rechecking the code thoroughly for me, I do appreciate your help a lot </SPAN></SPAN>

Good Luck</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Akuini]

Akuini, yes it correct, apart of that with the older code I found another problem too, say for example I filled data in column A with 266 rows and when I changed "z = 4" to "z = 266" it were generating only 165 random.

But with this last modified code it generate 266 Perfectly, and if I changed "z = 267" gives message "Something wrong" now the code is running 100% accurate

Thank you Akuini, for rechecking the code thoroughly for me, I do appreciate your help a lot

Good Luck

Kind Regards,
Kishan

You're welcome & glad it worked

 

[Rick Rothstein]

Hi Rick, thank you it worked as you said just changing the numbers in cell B1 generate x numbers i like the way it done.

Would it be complicate to get macro please?[/COLOR]</SPAN></SPAN>

I am sorry, but somehow I missed your request to make my event code into a macro. If you liked the way the event code worked, I am not sure why you wanted to replace it with a macro, but since you asked, here is the macro...

[table="width: 500"]
[tr]
	[td]Sub RandomCodeNumbers()
  Dim Arr As Variant, Cnt As Long, Idx As Long, Tmp As Variant
  Arr = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
  If Range("B1").Value < 1 + UBound(Arr) Then
    Range("C2", Cells(Rows.Count, "C").End(xlUp)).Offset(1).Clear
    For Cnt = UBound(Arr) To 1 Step -1
      Idx = Int(Cnt * Rnd + 1)
      Tmp = Arr(Idx, 1)
      Arr(Idx, 1) = Arr(Cnt, 1)
      Arr(Cnt, 1) = Tmp
    Next
    Range("C2").Resize(Range("B1").Value) = Arr
  Else
    MsgBox "You asked for more random values than there are values to choose from!", vbCritical
  End If
End Sub[/td]
[/tr]
[/table]

 

[Kishan]

I am sorry, but somehow I missed your request to make my event code into a macro. If you liked the way the event code worked, I am not sure why you wanted to replace it with a macro, but since you asked, here is the macro...

[TABLE="width: 500"]
<TBODY>[TR]
[TD]Sub RandomCodeNumbers()
  Dim Arr As Variant, Cnt As Long, Idx As Long, Tmp As Variant
  Arr = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
  If Range("B1").Value < 1 + UBound(Arr) Then
    Range("C2", Cells(Rows.Count, "C").End(xlUp)).Offset(1).Clear
    For Cnt = UBound(Arr) To 1 Step -1
      Idx = Int(Cnt * Rnd + 1)
      Tmp = Arr(Idx, 1)
      Arr(Idx, 1) = Arr(Cnt, 1)
      Arr(Cnt, 1) = Tmp
    Next
    Range("C2").Resize(Range("B1").Value) = Arr
  Else
    MsgBox "You asked for more random values than there are values to choose from!", vbCritical
  End If
End Sub
[/TD]
[/TR]
</TBODY>[/TABLE]

Hi Rick, yes I liked the event code and it worked fine too, there is no any particular reason, just I am used to macros and find comfortable using them.

Thank you for the macro solution it worked perfectly!!
I am extremely grateful to you, Rick, for your support.

Good Luck

Kind Regards,
Kishan