Errata....

"joeu2004" wrote:
For i = 1 To nSelect

Sorry. I failed to notice that the loop does not always generate the
correct number of samples.

See the attached macro. The for-loop is replaced by a do-loop.

-----

Option Explicit

Sub genSample()
Dim dSheet As Worksheet, sSheet As Worksheet
Dim nRow As Long, nCol As Long, nKey As Long
Dim nSelect As Long
Dim i As Long, d As Long, k As Long, r As Long
Dim c As Long
Dim data, myKey

' input data and stats
Set dSheet = Sheets("Data")
Set sSheet = Sheets("Stats")
nRow = sSheet.Range("a1")
With dSheet
nCol = .Range("a1").End(xlToRight).Column
data = .Range("a1").Resize(nRow, nCol)
End With
With sSheet
nKey = .Range("b1").End(xlDown).Row
myKey = .Range("b1").Resize(nKey, 2)
nSelect = 0
For i = 1 To nKey
If IsError(myKey(i, 1)) Then Exit For
If myKey(i, 1) = "" Then Exit For
nSelect = nSelect + myKey(i, 2)
Next
nKey = i - 1
End With
If nSelect = 0 Or nSelect nRow Then
MsgBox "error 1": Exit Sub
End If

' generate random results
ReDim res(1 To nSelect, 1 To nCol)
Randomize
r = 0
Do
d = 1 + Int(nRow * Rnd)
For k = 1 To nKey
If myKey(k, 1) = data(d, 1) Then Exit For
Next
If k <= nKey Then
If myKey(k, 2) 0 Then
r = r + 1
For c = 1 To nCol
res(r, c) = data(d, c)
Next
myKey(k, 2) = myKey(k, 2) - 1
If r = nSelect Then Exit Do
End If
End If
If d < nRow Then
For c = 1 To nCol
data(d, c) = data(nRow, c)
Next
End If
nRow = nRow - 1
Loop

' write results to new worksheet
dSheet.Select
Sheets.Add
Range("a1").Resize(nSelect, nCol) = res
End Sub