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>

 

[Rick Rothstein]

Using Excel 2000VBA, which can choose "x random numbers" from a list of column A (list in the column a can be max 290 rows)

Will the values in each cell in Column A be unique or could there be duplicates within the list?

 

[Marcelo Branco]

A possible solution using formulas

Array formula in C2 copied down
=IF(ROWS(C$2:C2)>B$1,"",INDEX(A$2:A$29,SMALL(IF(ISNA(MATCH(A$2:A$29,C$1:C1,0)),ROW(A$2:A$29)-ROW(A$2)+1,0),RANDBETWEEN(1+SUM(COUNTIF(C$1:C1,A$2:A$29)),ROWS(A$2:A$29)))))
Ctrl+Shift+Enter

M.

 

[Kishan]

A possible solution using formulas

Array formula in C2 copied down
=IF(ROWS(C$2:C2)>B$1,"",INDEX(A$2:A$29,SMALL(IF(ISNA(MATCH(A$2:A$29,C$1:C1,0)),ROW(A$2:A$29)-ROW(A$2)+1,0),RANDBETWEEN(1+SUM(COUNTIF(C$1:C1,A$2:A$29)),ROWS(A$2:A$29)))))
Ctrl+Shift+Enter

M.

Hi Marcelo Branco, formula worked and gives the random as per cell value B also hitting F9 produce the new sets. But could it be a VBA solution? </SPAN></SPAN>

Thank you for your kind help</SPAN></SPAN>

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

 

[Kishan]

Will the values in each cell in Column A be unique or could there be duplicates within the list?

Hi Rick, yes the values in each cell in Column A will be unique there will not be any single duplicates </SPAN></SPAN>

Thank you for asking a question to make a clarifying my request</SPAN></SPAN>

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

 

[Rick Rothstein]

Hi Rick, yes the values in each cell in Column A will be unique there will not be any single duplicates

Give this event code a try (it will automatically generate the list you want whenever you change the number in cell B1)...

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Arr As Variant, Cnt As Long, RandomIndex As Long, Tmp As Variant
  If Target.Address(0, 0) = "B1" Then
    Range("C2", Cells(Rows.Count, "C").End(xlUp)).Offset(1).Clear
    Arr = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value
    For Cnt = UBound(Arr) To LBound(Arr) Step -1
      RandomIndex = Int((Cnt - LBound(Arr) + 1) * Rnd + LBound(Arr))
      Tmp = Arr(RandomIndex, 1)
      Arr(RandomIndex, 1) = Arr(Cnt, 1)
      Arr(Cnt, 1) = Tmp
    Next
    Range("C2").Resize(Range("B1").Value) = Arr
  End If
End Sub[/td]
[/tr]
[/table]

HOW TO INSTALL Event Code
------------------------------------
If you are new to event code procedures, they are easy to install. To install it, right-click the name tab at the bottom of the worksheet that is to have the functionality to be provided by the event code and select "View Code" from the popup menu that appears. This will open up the code window for that worksheet. Copy/Paste the event code into that code window. That's it... the code will now operate automatically when its particular event procedure is raised by an action you take on the worksheet itself. Note... if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[Akuini]

This is just another way.
I use the Dictionary object to make sure there are no duplicate results. Because even if the data (in col A) is unique, the 'randbetween' function can hit the same 'spot' more than once, generating duplicated results.

[COLOR=blue]Sub[/COLOR] a1075487a[B]()[/B]
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1075487-choose-list-x-random-no-duplicates.html[/COLOR][/I]
[COLOR=blue]Dim[/COLOR] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR][B],[/B] x [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR][B],[/B] n [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
[COLOR=blue]Dim[/COLOR] d [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR][B],[/B] va
 
va [B]=[/B] Range[B]([/B][COLOR=brown]"A2"[/COLOR][B],[/B] Cells[B]([/B]Rows.count[B],[/B] [COLOR=brown]"A"[/COLOR][B]).[/B][COLOR=blue]End[/COLOR][B]([/B]xlUp[B]))[/B]
[COLOR=blue]Set[/COLOR] d [B]=[/B] CreateObject[B]([/B][COLOR=brown]"scripting.dictionary"[/COLOR][B])[/B]
 
    [COLOR=blue]For[/COLOR] i [B]=[/B] [B][COLOR=crimson]1[/COLOR][/B] [COLOR=blue]To[/COLOR] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B])[/B]
    x [B]=[/B] WorksheetFunction.RandBetween[B]([/B][B][COLOR=crimson]1[/COLOR][/B][B],[/B] UBound[B]([/B]va[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B]
    [I][COLOR=seagreen]'Debug.Print x[/COLOR][/I]
        [COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] d.Exists[B]([/B]va[B]([/B]x[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [COLOR=blue]Then[/COLOR]
            n [B]=[/B] n [B]+[/B] [B][COLOR=crimson]1[/COLOR][/B]
            d[B]([/B]va[B]([/B]x[B],[/B] [B][COLOR=crimson]1[/COLOR][/B][B]))[/B] [B]=[/B] [COLOR=brown]""[/COLOR]
            [COLOR=blue]If[/COLOR] n [B]=[/B] [B][COLOR=crimson]4[/COLOR][/B] [COLOR=blue]Then[/COLOR] [COLOR=blue]Exit[/COLOR] [COLOR=blue]For[/COLOR]
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]
    Range[B]([/B][COLOR=brown]"C2"[/COLOR][B]).[/B]Resize[B]([/B]d.count[B])[/B] [B]=[/B] Application.Transpose[B]([/B]d.Keys[B])[/B]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

 

[Kishan]

Give this event code a try (it will automatically generate the list you want whenever you change the number in cell B1)...

[TABLE="width: 500"]
<TBODY>[TR]
[TD]Private Sub Worksheet_Change(ByVal Target As Range)
  End Sub
[/TD]
[/TR]
</TBODY>[/TABLE]

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. </SPAN></SPAN>

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

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

 

[Kishan]

This is just another way.
I use the Dictionary object to make sure there are no duplicate results. Because even if the data (in col A) is unique, the 'randbetween' function can hit the same 'spot' more than once, generating duplicated results.

[COLOR=blue]Sub[/COLOR] a1075487a[B]()[/B]
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1075487-choose-list-x-random-no-duplicates.html[/COLOR][/I]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

Akuini, thank you for the macro solution, please can you check it highlights the line below in yellow and can get any results. I think the function does not work in excel 2000 may be I am wrong.</SPAN></SPAN>

</SPAN></SPAN>[COLOR=#000000]
x = WorksheetFunction.RandBetween(1, UBound(va, 1))[/COLOR]</SPAN></SPAN>[COLOR=#000000]
[/COLOR]

</SPAN></SPAN>

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

 

[Akuini]

Akuini, thank you for the macro solution, please can you check it highlights the line below in yellow and can get any results. I think the function does not work in excel 2000 may be I am wrong.

[COLOR=#000000]
x = WorksheetFunction.RandBetween(1, UBound(va, 1))[/COLOR][COLOR=#000000]
[/COLOR]

Kind Regards,
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)