Seleting 3 random unique values from a column of values

[Randolph]

Good day everyone.

I have a task to randomly pick 3 random values from column A and store them in column B in cells B1,B2,B3.
Column A contain string values. Column A has X number of available items.
Sample:

COLUMN A
name_tag1
name_tag2
.
.
.
name_tagX

COLUMN B
randompick1
randompick2
randompick3

I wan to write a VBA for a button which when clicked will populate column B with the 3 random values.

I have a sample which seems to work if i have the range as A1:A300 :

Sub RndCh()
Set ws = Sheets(1) 
rmv = Int((300-1+1) * Rnd + 1)
sh.Range("B1") = sh.Range("A" & rmv)
End Sub

So how do i make sure the values are unique. And how can i automatically determine the range of values in column A

Am

 

[RickXL]

Hi,

This is one way of doing it:

Sub Random()

    Dim sl As Object    ' Sorted List
    Dim ws As Worksheet
    Dim lr As Long
    Dim i As Long

    Set sl = CreateObject("System.Collections.SortedList")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Randomize
    
    With ws
        ' Find the Last Row in Column A
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        ' Set the SortedList to be the same size as the number of Rows
        sl.Capacity = lr
        
        ' Put an item in the SortedList for every Row
        Do While sl.Count < lr
            ' Add a random number and a sequential integer to the SortedList
            sl.Item(Rnd) = sl.Count + 1
        Loop
        
        ' Prints out the contents of the SortedList to the Immediate Window
        'For i = 1 To sl.Count
        '    Debug.Print sl.GetKey(i - 1), sl.GetByIndex(i - 1)
        'Next
    
        ' Selects the first 3 and copies to Column B
        For i = 1 To 3
            .Cells(i, "B").Value = .Cells(sl.GetByIndex(i - 1), "A").Value
        Next
    End With
     
End Sub

It works by making a list of number pairs. The first number in the pair is random and the second is sequential starting from 1. A list of 20 numbers could look like this:


[TABLE="width: 135"]
<tbody>[TR]
[TD]0.5730416
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]0.987094
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]0.5500515
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]0.8833349
[/TD]
[TD]4
[/TD]
[/TR]
[TR]
[TD]0.5045175
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]0.7153715
[/TD]
[TD]6
[/TD]
[/TR]
[TR]
[TD]4.71E-02
[/TD]
[TD]7
[/TD]
[/TR]
[TR]
[TD]0.5965233
[/TD]
[TD]8
[/TD]
[/TR]
[TR]
[TD]1.92E-03
[/TD]
[TD]9
[/TD]
[/TR]
[TR]
[TD]0.5622898
[/TD]
[TD]10
[/TD]
[/TR]
[TR]
[TD]0.7390149
[/TD]
[TD]11
[/TD]
[/TR]
[TR]
[TD]7.28E-02
[/TD]
[TD]12
[/TD]
[/TR]
[TR]
[TD]0.1671023
[/TD]
[TD]13
[/TD]
[/TR]
[TR]
[TD]0.5347461
[/TD]
[TD]14
[/TD]
[/TR]
[TR]
[TD]0.6675935
[/TD]
[TD]15
[/TD]
[/TR]
[TR]
[TD]0.9992146
[/TD]
[TD]16
[/TD]
[/TR]
[TR]
[TD]0.5013606
[/TD]
[TD]17
[/TD]
[/TR]
[TR]
[TD]0.4413949
[/TD]
[TD]18
[/TD]
[/TR]
[TR]
[TD]0.4693754
[/TD]
[TD]19
[/TD]
[/TR]
[TR]
[TD]0.2786834
[/TD]
[TD]20
[/TD]
[/TR]
</tbody>[/TABLE]

The list is then sorted using the random numbers so that random row numbers then appear in the second column. You can then pick as many numbers as you need to use as row numbers for selecting the data.

A SortedList is a structure that has the necessary two columns and as data is added it automatically sorts it into order so no separate sort step is required.

The work is done in this line:

sl.Item(Rnd) = sl.Count + 1

sl.Item(Rnd) adds the random number as a Key.
sl.Count + 1 is the associated Item. sl.Count is initially 0 because there are no items in the SortedList. As items are added the number increases. This is used later as a Row number to locate the random string.

 

[tybaltlives]

OK. so I need to credit the work of others for this solution:

This function generates a single string of three unique random numbers:
Excel: Generate Unique Random Numbers Between 2 Specified Numbers
In the example it is shown in cell E1. Currently it is set up to return numbers ranging between 1 and 300.

Then I used Rick Rothsteins function to separate the three numbers and put them in rows B1, B2, B3. I tried modifying the user function to just return the values directly to the cells rather than assembling the string - but I couldnt figure this part out. It would be a better way of helping you.

Finally, I used the INDEX function to search names in column A and return them.

Excel 2010
	A	B	C	D	E
1	name_tag1	name_tag231			231 191 186
2	name_tag2	name_tag191
3	name_tag3	name_tag186
4	name_tag4
5	name_tag5
6	name_tag6
Sheet1

Cell Formulas
Range	Formula
E1	=RandLotto(1,300,3)
B1	=INDEX(A1:A300,--TRIM(MID(SUBSTITUTE($E1," ",REPT(" ",99)),COLUMNS($E1:E1)*99-98,99)))
B2	=INDEX(A1:A300,--TRIM(MID(SUBSTITUTE($E1," ",REPT(" ",99)),COLUMNS($E1:F1)*99-98,99)))
B3	=INDEX(A1:A300,--TRIM(MID(SUBSTITUTE($E1," ",REPT(" ",99)),COLUMNS($E1:G1)*99-98,99)))

 

[Kenneth Hobson]

Sub ken_VPickRndX()
  Dim a() As Variant
  a() = WorksheetFunction.Transpose(Range("A1", Range("A" & Rows.Count).End(xlUp)))
  Range("B1:B3").Value = WorksheetFunction.Transpose(VPickRndX(a(), 3))
End Sub

Function VPickRndX(nArray() As Variant, iPick As Long) As Variant
  Dim i As Long, randIndex As Variant, Temp As Variant
  Randomize
  For i = 1 To iPick
    randIndex = Int(Rnd * UBound(nArray)) + 1
    Temp = nArray(i)
    nArray(i) = nArray(randIndex)
    nArray(randIndex) = Temp
  Next i
  ReDim Preserve nArray(1 To iPick)
  VPickRndX = nArray()
End Function