Select N random values from Column A where Column B < 100

[rlekkala]

A	B	C	D
A1	90	2	A4
A2	150		A6
A3	120
A4	80
A5	60
A6	77
A7	110
A8	100
A9	45

<tbody>
</tbody>

Based on whatever number (N) I enter in cell C2. I will need the next column (Column D) to populate random values satisfying the condition where Column B < 100
For N = 2 lets say I get 2 of the 5 possible values from column A (A1, A4, A5, A6, A9). If I enter 6 then It should pull all 5 values and mention that only 5 values are returned may be in cell C3?
Can a macros be written to accomplish this?

 

[rlekkala]

oops - dim n as long
Thanks shg

Hi, I was trying to modify the code and change the input parameters so that a person can input the number of values they want chosen, and define a range (instead of all of the rows) a starting row number and an ending row number? Based on the amount of codes they want generated and the cell range, the macro will produce a list of randomly generated codes in a new worksheet that I’ve called “Random”?
Is this possible? Thank you very much for the being of great help.

 

[JoeMo]

Hi, I was trying to modify the code and change the input parameters so that a person can input the number of values they want chosen, and define a range (instead of all of the rows) a starting row number and an ending row number? Based on the amount of codes they want generated and the cell range, the macro will produce a list of randomly generated codes in a new worksheet that I’ve called “Random”?
Is this possible? Thank you very much for the being of great help.

Try this. User selects the range with a mouse, then inputs how many random picks to generate in column A of a new sheet called "Random" that is added.

Sub GenerateRandomPicks()
Dim lR As Long, R As Range, T As Double
Dim C As Integer, d As Object, S1 As Worksheet, S2 As Worksheet

Set S1 = ActiveSheet
On Error Resume Next
Set R = S1.Application.InputBox("Select a range of values with your mouse", Type:=8)
If R Is Nothing Then Exit Sub
If R.Columns.Count <> 1 Then
    MsgBox "Please select a single column only."
    Exit Sub
End If
On Error GoTo 0
C = Application.InputBox("How many values?", Type:=1)
Set d = CreateObject("Scripting.dictionary")
d.RemoveAll
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Random").Delete
On Error GoTo 0
Set S2 = Sheets.Add(after:=S1)
S2.Name = "Random"
With S2.Columns("A")
    Do
        T = WorksheetFunction.RandBetween(1, R.Rows.Count)
        If S1.Cells(T, 2).Value < 100 And Not d.exists(CStr(T)) Then
            n = n + 1
            d.Add CStr(T), n
            .Cells(n).Value = S1.Cells(T, 1).Value
        End If
    Loop Until n = C Or d.Count = WorksheetFunction.CountIf(R, "<100")
    If d.Count = WorksheetFunction.CountIf(R, "<100") And n < C Then
          .Cells(n + 1).Value = "No more values meet the criteria"
    End If
End With
End Sub