how to get unique 30 random numbers from a list using VBA code

Viewed 163

i have list of numbers B201:B523 . i want to extract 30 random numbers from this list in E200:E230.

i used this code. It is giving only 1 random number in all output cell.

Sub Generate_random_values_from_a_column()

'declare a variable
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
ws.Range("e200:e229") = WorksheetFunction.Index(Range("B201:B523"), WorksheetFunction.RandBetween(1, ws.Range("B201:B523").Rows.Count), 1)

End Sub

then i tried some other codes but those were worse then this.

2 Answers

We can put the formula first in the cell and then change it to values.

Sub Generate_random_values_from_a_column()
    'declare a variable
    Dim ws As Worksheet
    Set ws = Worksheets("sheet1")
    
    With ws
        .Range("e200:e229").Formula = "=RANDBETWEEN(1, " & .Range("B201:B523").Rows.Count & ")"
        .Range("e200:e229").Value = .Range("e200:e229").Value
    End With
End Sub

enter image description here

Your code is returning 1 random number because it only calculates WorksheetFunction.RandBetween(1, ws.Range("B201:B523").Rows.Count) once.

Try the code below, I have tried to comment as detailed as possible but ask if you don't understand any part.

Sub GetUniqueRandomNum()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("sheet1")
    
    Const outputCount As Long = 30              'Number of output you want
    Const outputFirstCell As String = "E200"    'Address of the output first cell
    
    Const numStartRow As Long = 201 'First row of the list of numbers
    Const numEndRow As Long = 523   'Last row of the list of numbers
    Const numColumn As Long = 2     'Column index of the list of numbers
    
    'Store the values of the list of numbers in an array (to avoid reading from cells unnecessary)
    Dim numList As Variant
    numList = ws.Range(ws.Cells(numStartRow, numColumn), ws.Cells(numEndRow, numColumn)).Value
    
    Dim uniqueNum As Object
    Set uniqueNum = CreateObject("Scripting.Dictionary")
        
    'Generate a random number and add the corresponding value in dictionary if it does not exist, stop once it has 30 entires
    Do While uniqueNum.Count <> outputCount
        Dim inputVal As Long
        inputVal = Application.RandBetween(1, UBound(numList))
        
        If Not uniqueNum.Exists(numList(inputVal, 1)) Then
            uniqueNum.Add (numList(inputVal, 1)), 1
        End If
    Loop
    
    Dim uniqueList As Variant
    uniqueList = uniqueNum.Keys
    
    'Write output to worksheet
    ws.Range(outputFirstCell).Resize(outputCount).Value = Application.WorksheetFunction.Transpose(uniqueList)
End Sub
Related