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
.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