Hi Dale,

Posted below are two user-defined functions created by Dave Braden, an Excel MVP many times over, for sampling without replacement.

The posts can be found at this link:

http://groups.google.com/groups?hl=e...D%40fiastl.net

Dave is awesome. He is leading the charge to fix the statistical functions in the Analysis ToolPak. He, together with Jerry W. Lewis, have posted some amazing code. (I worked on the Hypergeometric function for them, but put it away for awhile.)

Anyway, please post back if this isn't what you need.

First function uses a sheet range. Second is more flexible. Please see Dave's instructions at the end.

-------------------------------

Function HGSample(data As Range, ByVal SampleSize As Integer) As Variant

' Returns a hypergeometric sample of Samplesize from a range, assumed to be columnar

'PLEASE retain all comments: Posted to microsoft.public.excel.misc

'Written 1999/4/1 David J. Braden tmy@fiastl.net

Dim hiP1 As Long, i As Long, j As Long

Dim ret() As Variant, temp As Variant

'Application.Volatile 'to make this a variate generator, uncomment this line

temp = data

hiP1 = data.Rows.Count + 1

If SampleSize > UBound(temp) Then SampleSize = UBound(temp)

ReDim ret(1 To SampleSize, 1 To 1)

For i = 1 To SampleSize

j = i + Int(Rnd * (hiP1 - i))

ret(i, 1) = temp(j, 1): temp(j, 1) = temp(i, 1)

Next i

HGSample = ret

End Function

Function HGSample2a(ByVal lo As Long, ByVal hi As Long, ByVal SampleSize As Long) As Variant

'Returns a sample, without replacement, of SampleSize from the range lo to hi

'Written 1999/7/7 David J. Braden tmy@fiastl.net

'PLEASE retain all comments: Posted to microsoft.public.excel.*

Dim hiP1 As Long, i As Long, j As Long

Dim ret() As Variant, temp As Variant

Application.Volatile 'to make this a variate generator, uncomment this line

'The following allows more flexible specification of the support.

If lo > hi Then temp = lo: lo = hi - 1: hi = temp Else lo = lo - 1

ReDim temp(1 To hi - lo)

For i = hi - lo To 1 Step -1

temp(i) = i

Next

hiP1 = UBound(temp) + 1

If SampleSize > UBound(temp) Then SampleSize = UBound(temp)

ReDim ret(1 To SampleSize, 1 To 1)

For i = 1 To SampleSize

j = i + Int(Rnd * (hiP1 - i))

ret(i, 1) = temp(j) + lo: temp(j) = temp(i)

Next i

HGSample2a = ret

End Function

'As with the earlier function, this returns an array, so you need to do a

'ctrl-shift-enter, no matter how you use it (in another function, or for explicit

'display of the sample, or whatever). To see a draw, select B1:B25, array-enter

'=HGsample2a(1,50,25), and you have it. This function allows flexible

'specification of the set of integers being sampled from. It could be more

'robust still by specifying lo and hi as variants, then checking that they are in

'fact integers, but I'll leave that overhead to others.

---------------------------------

HTH,

Jay

## Like this thread? Share it with others