Hi Winon,
Thanks for your time.After a long search and recording macro i come up with this code, it can give me hundreds of sets, but i can not find
to check and prevent duplicate trios.So i would much appreciate for any help on that.
here is the code;
Sub generatenumbers()
Const w = 15
Dim r As Long, Reason As Long
For r = 1 To w
Const l& = 1 'lower value
Const u& = 40 'upper value
Const N& = 5 'number of numbers per row
Dim a(), b() As Boolean
Dim rws&, i&, x&, k&
rws = 8 'number of rows
ReDim a(1 To rws, 1 To N)
Dim LastRow As Long
Randomize
ReDim b(l To u): s = ""
For i = 1 To rws
k = 0
Do
x = Int(Rnd * u) + l
If Not b(x) Then
k = k + 1
b(x) = True
a(i, k) = x
End If
Loop Until k = N
Next i
Range("C1").Resize(rws, N) = a
Range("C1:g8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow + 2).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
Next
End Sub
kind regards
sem
Bookmarks