No guarantees, but this appears to do something similar to what Jerry
described in the original thread.

Option Explicit
Sub Generate5000Setsof8()
Dim dist As Variant, distA As Variant
Dim dist1 As Variant
Dim sNum As Single
Dim ll As Long, i As Long, j As Long
Dim rnum(1 To 8) As Variant
Application.Calculation = xlManual
Randomize Time
dist = Range("AI1:AJ32")

Dim rng As Range
Set rng = Range("A2")
For ll = 1 To 5000
For i = 1 To 8
If i = 1 Then
dist = Range("AI1:AJ32")
dist1 = BuildCum(dist)
Else
If i = 2 Then
distA = BuildDist(dist)
Else
distA = BuildDist(distA)
End If
' Debug.Print i, TypeName(distA)
' Debug.Print LBound(distA, 1), UBound(distA, 1), LBound(distA, 2),
UBound(distA, 2)

dist1 = BuildCum(distA)
End If
' If i = 1 Then
' Range("AK1:AK32").Value = Application.Transpose(dist1)
' Else
' Range("Ai1").Offset(0, i * 3 - 2).Resize(UBound(distA, 1) -
LBound(distA, 1) _
' + 1, UBound(distA, 2) - LBound(distA, 2) + 1).Value = _
' distA
' Range("Ai1").Offset(0, i * 3).Resize(UBound(dist1, 1) - LBound(dist1, 1)
+ 1, 1) _
' .Value = Application.Transpose(dist1)
' End If
sNum = Rnd
For j = LBound(dist1) To UBound(dist1)
' Debug.Print j, snum, dist1(j)
If sNum <= dist1(j) Then
If i = 1 Then
rnum(i) = dist(j, LBound(dist, 2))
dist(j, LBound(dist, 2)) = 0
' Debug.Print "item: " & j
Else
rnum(i) = distA(j, LBound(distA, 2))
distA(j, LBound(distA, 2)) = 0
' Debug.Print "Item: " & j
End If
Exit For
End If
Next j
Next i
'For kl = 1 To 8
' Debug.Print rnum(kl);
'Next
Range("A2").Offset(ll - 1, 0).Resize(1, 8).Value = rnum
Next ll
Application.Calculation = xlAutomatic

End Sub
Function BuildDist(varr)
Dim distA() As Variant
Dim tot As Double
'Debug.Print "Builddist", LBound(varr, 1), UBound(varr, 1), _
' LBound(varr, 2), UBound(varr, 2)
Dim i As Long, j As Long, k As Long
ReDim distA(LBound(varr, 1) To UBound(varr, 1) - 1, _
LBound(varr, 2) To UBound(varr, 2))
i = LBound(varr, 1)
For j = i To UBound(varr, 1)
If varr(j, LBound(varr, 2)) < 0 Then
For k = LBound(varr, 2) To UBound(varr, 2)
distA(i, k) = varr(j, k)
Next
tot = tot + distA(i, UBound(varr, 2))
i = i + 1
End If
Next
For j = LBound(distA, 1) To UBound(distA, 1)
distA(j, UBound(distA, 2)) = _
(distA(j, UBound(distA, 2)) / tot)
Next
BuildDist = distA
End Function


Function BuildCum(varr) As Variant
Dim dist1()
Dim i As Long
ReDim dist1(LBound(varr, 1) To UBound(varr, 1))
For i = LBound(dist1) To UBound(dist1)
If i = LBound(dist1) Then
dist1(i) = varr(i, UBound(varr, 2))
Else
dist1(i) = dist1(i - 1) + varr(i, UBound(varr, 2))
End If
Next
'Debug.Print "Cum: " & dist1(UBound(dist1, 1))
BuildCum = dist1
End Function



--
Regards,
Tom Ogilvy

"Aristotele64" wrote in message
...

"Tom Ogilvy" ha scritto nel messaggio
...
Hi from Italy......so sorry for my bad english.....

Guess your English is bad. I have no idea what you are trying to say.


american are the best () in the word to use excel !
italian are the (<) in the word
by