Produce Random Numbers

[S.H.A.D.O.]

Good evening,

I am trying to write a program that outputs 5 random numbers without repetition from 50 numbers.
The number of combinations to be produced is in worksheet "Random Numbers" and in cell "P3".
The code below works as far as the above is concerned.

Sub Random_Numbers_Generator()
Dim nDrawnMain As Long
Dim nFromMain As Long
Dim nDrawnLucky As Long
Dim nFromLucky As Long
Dim nComb As Long
Dim myMain() As Variant
Dim myLucky() As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

nDrawnMain = 5
nFromMain = 50
nDrawnLucky = 2
nFromLucky = 9

Worksheets("Random Numbers").Select

With ActiveSheet
    Range("A1:J65536").Select
    Selection.ClearContents
    ReDim myMain(1 To nFromMain)
    ReDim myLucky(1 To nFromLucky)
    '	nDrawn = .Range("N3").Value
    '	nFrom = .Range("O3").Value
    nComb = .Range("P3").Value
End With

For j = 1 To nComb
 
    For H = 1 To nFromMain
        myMain(H) = H
    Next H
    
    For k = 1 To nDrawnMain
        Randomize
NewNumber:
        Number = Int(nFromMain * Rnd) + 1
        If myMain(Number) = "" Then
            GoTo NewNumber
        Else
            Cells(j, k) = myMain(Number)
            myMain(Number) = ""
        End If
    Next k
Next j

Range("N3").Select

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

What I would like to add is to output 2 random numbers without repetition from 9 numbers.
I would like to output these 2 extra numbers after it has produced the 5th number and skipped two cells to the right from the previous combination.
Both these combinations are totally seperate from each other so could possibly have the same numbers in them.

So basically, the program will produce two sets of random numbers without repetition:-
The first being 5 numbers from 50 numbers.
The second being 2 numbers from 9 numbers.
The 5 numbers will be output in cells A1:E1 and the 2 numbers will be output in cells G1:H1.

 

[shg]

Public Function aiRandLong(iMin As Long, _
                           iMax As Long, _
                           Optional ByVal n As Long = -1, _
                           Optional bVolatile As Boolean = False) As Long()
    ' UDF or VBA
    ' Adapted from Chip Pearson at [URL]http://www.cpearson.com/excel/RandomNumbers.aspx[/URL]
    ' Returns a 1-based array of n unique Longs between iMin and iMax inclusive
    Dim aiSrc()     As Long
    Dim aiOut()     As Long
    Dim iSrc        As Long
    Dim iOut        As Long
    Dim iTop        As Long
 
    If bVolatile Then Application.Volatile
 
    If n = -1 Then n = iMax - iMin + 1
    If iMin > iMax Or n > (iMax - iMin + 1) Or n < 1 Then Exit Function
 
    ReDim aiSrc(iMin To iMax)
    ReDim aiOut(1 To n)
 
    ' init iSrc
    For iSrc = iMin To iMax
        aiSrc(iSrc) = iSrc
    Next iSrc
 
    iTop = iMax
 
    For iOut = 1 To n
        ' pick a number between 1 and iTop, swap with iTop, decrement iTop
        iSrc = Int((iTop - iMin + 1) * Rnd) + iMin
        aiOut(iOut) = aiSrc(iSrc)
        aiSrc(iSrc) = aiSrc(iTop)
        iTop = iTop - 1
    Next iOut
 
    aiRandLong = aiOut
End Function

Select A1:E1, paste =aiRandLong(1,50,5) in the formula bar, and confirm with Ctrl+Shift+Enter.

Select G1:H1, paste =aiRandLong(1,9,2) in the formula bar, and confirm with Ctrl+Shift+Enter.

 

[S.H.A.D.O.]

Thanks for the reply shg,

Your solution does indeed work and produces the correct information.
What I would like to achieve though is to be able to adapt my existing code because I have attached it to a button and it is much easier to just click the button to produce another single combination or several combinations.
Thanks in advance.

 

[shg]

Okay:

Sub Random_Numbers_Generator()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    With Worksheets("Random Numbers")
        .Columns("A:J").ClearContents
        
        With .Range("A1:E1")
            .FormulaArray = "=aiRandLong(1,50,5)"
            .Value = .Value
        End With
 
        With .Range("G1:H1")
            .FormulaArray = "=aiRandLong(1,9,2)"
            .Value = .Value
        End With
 
        Application.Goto .Range("N3")
    End With
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[S.H.A.D.O.]

Hi shg,

Sorry to be a pain, but unfortunately when I run the code from the button it returns #NAME? error on all the cells. It is however showing the error on the first five cells, skipping two cells and showing the error on the next two cells, which is the correct format.
Also, on the worksheet "Random Numbers" in cell "P3" I input a figure for the number of combinations to be produced.
Thanks in advance.

 

[shg]

You need to include the function I posted previously.

 

[S.H.A.D.O.]

Brilliant shg,

Produces exactly as wanted for one combination.
On the worksheet "Random Numbers" in cell "P3" I input the number of combinations I want produced. This could be any number for example. Is it possible to adapt the code to produce the number of combinations in this cell please.
Thanks in advance.

 

[shg]

Produce them where?

 

[S.H.A.D.O.]

Hi shg,

Each combination will obviously be a new calculation based on the criteria starting from scratch.
I would like them directly after each other down columns A:H.
Thank you.

 

[wigi]

Did you take a look in the help files for "Resize"?

Sub Random_Numbers_Generator()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    With Worksheets("Random Numbers")
        .Columns("A:J").ClearContents
        
        With .Range("A1:E1").Resize(.Range("P3").Value)
            .FormulaArray = "=aiRandLong(1,50,5)"
            .Value = .Value
        End With
 
        With .Range("G1:H1").Resize(.Range("P3").Value)
            .FormulaArray = "=aiRandLong(1,9,2)"
            .Value = .Value
        End With
 
        Application.Goto .Range("N3")
    End With
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub