Link to home
Start Free TrialLog in
Avatar of Saqib Husain
Saqib HusainFlag for Pakistan

asked on

VBA: Generating random numbers

Can someone give me code to generate 4 random numbers in D1:G1 from 1 to 8 with no repetitions?
Avatar of dlmille
dlmille
Flag of United States of America image

VBA Code?  http://www.mcgimpsey.com/excel/udfs/randint.html

If they can be static after creation, MOREFUNC has the MRAND function you might be interested in.

Dave
Note:  the McGimpsey function is entered by first selecting the range D1:G1, entering the function in D1 =RandInt(1,8) then CTRL-SHIFT-ENTER to confirm.  obtaining you a non-repeating result.

Dave
Avatar of Saqib Husain

ASKER

Yes, Dave, I got that but I want static numbers...for a game so that the numbers stay until I want a new set. I could write it myself but why not let someone else get the points.

Saqib
MOREFUNC MRAND function?  It has an option for static results or not.

I just tested it and it works, swell.

Dave
Enter:

=MRAND(,1,8,TRUE) in D1:G1 and CTRL-SHIFT-ENTER to confirm.

Dave
ASKER CERTIFIED SOLUTION
Avatar of dlmille
dlmille
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Apologies - I meant to set to late binding so you don't need the Scripting Runtime.  here it is attached.

Dave
genRandWStaticOpt-lateBind-r2.xlsm
Saqib,

See attached. I created to create Lucky Dip combinations for Lottery Numbers.

Parameters to enter in B1 to B4:
  Lowest parameter
  Highest parameters
  Quantity of numbers per set
  Number of sets

Click button.

Cheers
Rob H
 
Code for those that can't/won't download file:

Sub Generate()
Dim Repeat As Integer
Dim PerSet As Integer

Repeat = Range("Repeat")
PerSet = Range("PerSet")

GoSub Clear

Application.ScreenUpdating = False

For R = 1 To Repeat
    For P = 1 To PerSet
        GoSub Create
        GoSub Populate
    Next P
Next R

Application.ScreenUpdating = True

Exit Sub

Clear:
    Range("First").Select
    Selection.CurrentRegion.Select
    Selection.ClearContents
    Range("First").Select
    Return

Create:
    Do
    Range("H1") = R + 6
    Calculate
    Loop Until Range("Check") = 0
    V = Range("Value")
    Return

Populate:
    If P = 1 Then
    Range("First").Select
    ActiveCell.Offset(R - 1, 0).Range("A1").Select
    ActiveCell.Value = V
    Else
    Range("First").Select
    ActiveCell.Offset(R - 1, 0).Range("A1").Select
    ActiveCell.Offset(0, P - 1).Range("A1").Select
    ActiveCell.Value = V
    End If
    Return
    
Sort:
    Return
    
End Sub

Open in new window


Cheers
Rob H
Mine's modified as well - not my random number routine - its solid, but the McGimpsey function - have to change it to

=randint(1,8)+(A2*0) <- will refresh when A2 changes, or when subroutines are changed it appears the application.volatile doesn't hold fast.

As you're triggering the change anyway, suggest you just stick with the function I wrote and shared in my prior post 37119281

Its clean and appears solid from testing.  I made one more modification for generic use, though my prior post supports the exact request (D1:G1 and 1-8 for scope of random numbers)...

This does error checking to ensure its more generic for other ranges (checks count so it doesn't go infinite trying to generate rnd numbers for more cells than unique results would support :)

Final update:
 
Sub Button1_Click()
    Call genRandUnique(Range("D1:G1"), 1, 8)
End Sub
Sub genRandUnique(rng As Range, startNo As Long, endNo As Long)
Dim myCell As Range
Dim dict As Object
Dim cnt As Long

    If rng.Count > endNo - startNo Then
        MsgBox "Cannot compute unique Random Numbers as there are too many cells"
        Exit Sub
    End If
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    For Each myCell In rng
getRnd:
        myCell.Value = Evaluate("Randbetween(" & startNo & "," & endNo & ")")
        If dict.Exists(myCell.Value) Then
            GoTo getRnd
        Else
            dict.Add myCell.Value, cnt
            cnt = cnt + 1
        End If
    Next myCell
            
    dict.RemoveAll
    Set dict = Nothing
End Sub

Open in new window


See attached.

Dave
genRandWStaticOpt-lateBind-r3.xlsm
Thanks and sorry for the delay