Select 5 random values in a dynamic range

[mista_v]

Hi all,

I'm using the following code to select 5 random numbers from D2 to D50 and then posting those 5 random numbers starting in D52. My problem is that sometimes there are only 15 rows with data in the range. So this macro also selects blank cells. Anyone an idea how to modify the code I'm using? Thank you!

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")

Const outputCount As Long = 5 'Number of output you want
Const outputFirstCell As String = "D52" 'Address of the output first cell

Const numStartRow As Long = 2 'First row of the list of numbers
Const numEndRow As Long = 50 'Last row of the list of numbers
Const numColumn As Long = 4 '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)

 

[offthelip]

You just need to change how you define numendrow

'Const numEndRow As Long = 50 'Last row of the list of numbers change this line to:
Dim numEndRow As Long
numEndRow = Cells(Rows.Count, numColumn).End(xlUp).Row

You also need to move it after the row

Const numColumn As Long = 4 'Column index of the list of numbers

 

[mista_v]

Thank you very much. Works perfectly