View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joeu2004[_2_] joeu2004[_2_] is offline
external usenet poster
 
Posts: 829
Default Random selection of records based on specifc value

"Ixtreme" wrote:
Through vba I automatically want to select 29 random
'apples' rows, 64 random peers rows and 7 random
oranges rows and copy them to sheet2.


Perhaps you can make use of the following, at least as a start.

This code assumes that each row of data consists of 3 columns: A, B and C.
And there are 1000 rows of data starting in row 2.

Note: Although the selection of each apple, orange and pear row is random,
the output consists of all apple samples, then all orange samples, then all
pear samples. If you want those shuffled, some additional work is needed.

-----

Option Explicit

Sub genData()
Const nSample As Long = 100
Dim s(1 To nSample, 1 To 3), v
Dim n As Long, i As Long
Dim nApple As Long, nOrange As Long, nPear As Long
Dim sApple As Long, sOrange As Long, sPear As Long

' input data
v = Sheets("Sheet1").Range("a2:c1001")
n = UBound(v, 1)
ReDim apple(1 To n) As Long
ReDim orange(1 To n) As Long
ReDim pear(1 To n) As Long
nApple = 0: nOrange = 0: nPear = 0
For i = 1 To n
Select Case v(i, 1)
Case "apple"
nApple = nApple + 1
apple(nApple) = i
Case "orange"
nOrange = nOrange + 1
orange(nOrange) = i
Case "pear"
nPear = nPear + 1
pear(nPear) = i
End Select
Next

' select random data
If nSample nApple + nOrange + nPear Then
MsgBox "error"
Exit Sub
End If
Randomize
sApple = Int(nApple / n * nSample)
sOrange = Int(nOrange / n * nSample)
sPear = nSample - sApple - sOrange
doSelect sApple, apple, nApple, v, s, 0
doSelect sOrange, orange, nOrange, v, s, sApple
doSelect sPear, pear, nPear, v, s, sApple + sOrange
Sheets("sheet2").Range("a1", "c" & nSample) = s
End Sub


Private Sub doSelect(ByVal nSample As Long, myRow0() As Long, _
ByVal nRow As Long, v, s(), ByVal i As Long)
Dim j As Long, x As Long, r As Long
ReDim myRow(1 To nRow) As Long
If nSample <= 0 Then Exit Sub
For j = 1 To nRow: myRow(j) = myRow0(j): Next
Do
x = 1 + Int(nSample * Rnd)
r = myRow(x)
i = i + 1
s(i, 1) = v(r, 1)
s(i, 2) = v(r, 2)
s(i, 3) = v(r, 3)
If x < nSample Then myRow(x) = myRow(nSample)
nSample = nSample - 1
Loop Until nSample = 0
End Sub