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

rlekkala

New Member
Joined
Feb 3, 2009
Messages
49
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?
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
How about using formulas?

Code:
      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))
 
Upvote 0
If you'd prefer a macro:
Code:
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
 
Last edited:
Upvote 0
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
Code:
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
 
Upvote 0
I see Joe has suggested a macro, as you requested.
Here's another you may like to try
Code:
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(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
 
Last edited:
Upvote 0
The undeclared variables n and ctr default to Variant/Integer. They should be declared as Long.
 
Upvote 0
Here's a more robust version of the code I posted earlier (still using the original layout from the first post in this thread):
Code:
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
 
Upvote 0
n is still not declared, Joe.
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,122
Members
448,550
Latest member
CAT RG

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top