LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #2   Report Post  
Posted to microsoft.public.excel.programming
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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Random Selection based on Difficulty [email protected] Excel Discussion (Misc queries) 4 May 13th 07 03:31 AM
Copy / Paste Specifc Row based on Input Box Value Carlee Excel Programming 7 April 1st 07 05:06 PM
draw 999 x 8 random records from file with 8614 records news.wanadoo.nl Excel Programming 1 March 1st 06 03:04 PM
Create summary based on specifc value in a different sheet RayYeung Excel Worksheet Functions 0 July 19th 05 05:39 AM
selecting random records terry freedman Excel Programming 2 April 2nd 04 11:07 AM


All times are GMT +1. The time now is 07:38 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"