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

[rlekkala]

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[/TR]
[TR]
[TD]A1
[/TD]
[TD]90
[/TD]
[TD]2
[/TD]
[TD]A4
[/TD]
[/TR]
[TR]
[TD]A2
[/TD]
[TD]150
[/TD]
[TD][/TD]
[TD]A6
[/TD]
[/TR]
[TR]
[TD]A3
[/TD]
[TD]120
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A4
[/TD]
[TD]80
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A5
[/TD]
[TD]60
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A6
[/TD]
[TD]77
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A7
[/TD]
[TD]110
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A8
[/TD]
[TD]100
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A9
[/TD]
[TD]45
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
















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?

 

[shg]

How about using formulas?

      A- -B- --C--- --D--
  1   A1  90 0.2631 A9   
  2   A2 150        A4   
  3   A3 120        A6   
  4   A4  80 0.8376 A5   
  5   A5  60 0.7749 A1   
  6   A6  77 0.8338 #NUM!
  7   A7 110             
  8   A8 100             
  9   A9  45 0.9043

In B1 and copied down, =IF(B1 < 100, RAND(), "")

In D1 and copied down, =INDEX($A$1:$A$9, MATCH(LARGE($C$1:$C$9, ROWS(D$1:D1)), $C$1:$C$9, 0))

 

[JoeMo]

If you'd prefer a macro:

Sub GenerateRandomPicks()
Dim lR As Long, R As Range, T As Double
Dim C As Integer, d As Object
lR = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B1", "B" & lR)
C = Range("C1").Value
Set d = CreateObject("Scripting.dictionary")
d.RemoveAll
With Columns("D")
    Do
        T = Int(Rnd * (R.Rows.Count - 1) + 1)
        If Cells(T, 2).Value < 100 And Not d.exists(CStr(T)) Then
            n = n + 1
            d.Add CStr(T), n
            .Cells(n).Value = Cells(T, 1).Value
        Else
            ctr = ctr + 1
        End If
    Loop Until n = C Or ctr = 100 * R.Rows.Count
    If ctr = 100 * R.Rows.Count Then
          .Cells(n + 1).Value = "No more values meet the criteria"
    End If
End With
End Sub

 

[mirabeau]

Can a macros be written to accomplish this?

I see Joe has suggested a macro, as you requested.
Here's another you may like to try

Sub randomz()
Dim b() As Boolean, a As Range
Dim rws As Long, x As Long, u As Long
Set a = Cells(1).CurrentRegion
rws = a.Rows.Count
ReDim b(1 To rws)
Randomize
Do
    x = Int(Rnd * rws) + 1
    If (Not b(x)) * (a(x, 2) < 100) * (x > 1) Then
        c = c + 1
        a(c + 1, 4) = a(x, 1)
        b(x) = True
    End If
    u = u + 1
    If u > 500 * rws Then MsgBox "There are less than " & a(2, 3) & _
        " values in ColA meeting the criteria": Exit Do
Loop Until c = a(2, 3)
End Sub

 

[rlekkala]

I see Joe has suggested a macro, as you requested.
Here's another you may like to try

Sub randomz()
Dim b() As Boolean, a As Range
Dim rws As Long, x As Long, u As Long
Set a = Cells(1).CurrentRegion
rws = a.Rows.Count
ReDim b(1 To rws)
Randomize
Do
    x = Int(Rnd * rws) + 1
    If (Not b(x)) * (a(x, 2) < 100) * (x > 1) Then
        c = c + 1
        a(c + 1, 4) = a(x, 1)
        b(x) = True
    End If
    u = u + 1
    If u > 500 * rws Then MsgBox "There are less than " & a(2, 3) & _
        " values in ColA meeting the criteria": Exit Do
Loop Until c = a(2, 3)
End Sub

I updated the above code to fit my new columns and criteria.
Column A - Column A (no change)
Column B - Column D instead
Column C - Column E instead
Column D - column F instead
The comparison is with 1000,000 not 100.
The data range starts from row 3
Below code now generates overflow error. Can you help me resolve this?
Sub GenerateRandomPicks()
Dim lR As Long, R As Range, T As Double
Dim C As Integer, d As Object
lR = Range("D" & Rows.Count).End(xlUp).Row
Set R = Range("D3", "D" & lR)
C = Range("E3").Value
Set d = CreateObject("Scripting.dictionary")
d.RemoveAll
With Columns("F")
Do
T = Int(Rnd * (R.Rows.Count - 1) + 1)
If Cells(T, 4).Value < 100 And Not d.exists(CStr(T)) Then
n = n + 1
d.Add CStr(T), n
.Cells.Value = Cells(T, 1).Value
Else
ctr = ctr + 1
End If
Loop Until n = C Or ctr = 100 * R.Rows.Count
If ctr = 100 * R.Rows.Count Then
.Cells(n + 1).Value = "No more values meet the criteria"
End If
End With
End Sub

 

[shg]

The undeclared variables n and ctr default to Variant/Integer. They should be declared as Long.

 

[JoeMo]

Here's a more robust version of the code I posted earlier (still using the original layout from the first post in this thread):

Sub GenerateRandomPicks()
Dim lR As Long, R As Range, T As Double
Dim C As Integer, d As Object
lR = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B1", "B" & lR)
C = Range("C1").Value
Set d = CreateObject("Scripting.dictionary")
d.RemoveAll
With Columns("D")
    Do
        T = Int(Rnd * (R.Rows.Count - 1) + 1)
        If Cells(T, 2).Value < 100 And Not d.exists(CStr(T)) Then
            n = n + 1
            d.Add CStr(T), n
            .Cells(n).Value = 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

 

[shg]

n is still not declared, Joe.

 

[JoeMo]

n is still not declared, Joe.

oops - dim n as long
Thanks shg

 

[rlekkala]

Thanks guys! the above code worked fine and resolved my issue.