Saqib Husain
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?
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
Dave
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
Saqib
MOREFUNC MRAND function? It has an option for static results or not.
I just tested it and it works, swell.
Dave
I just tested it and it works, swell.
Dave
Enter:
=MRAND(,1,8,TRUE) in D1:G1 and CTRL-SHIFT-ENTER to confirm.
Dave
=MRAND(,1,8,TRUE) in D1:G1 and CTRL-SHIFT-ENTER to confirm.
Dave
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
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:
Cheers
Rob H
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
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:
See attached.
Dave
genRandWStaticOpt-lateBind-r3.xlsm
=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
See attached.
Dave
genRandWStaticOpt-lateBind-r3.xlsm
ASKER
Thanks and sorry for the delay
If they can be static after creation, MOREFUNC has the MRAND function you might be interested in.
Dave