PDA

View Full Version : Random numbers in range



hockey1234
11-10-2010, 07:51 PM
Here is my code:
Private Sub CommandButton2_Click()
Dim randomnumbers As Range
Set randomnumbers = Range("E14:E19")
randomnumbers = Int((42 * Rnd) + 1)
End Sub
The problem is that I want 6 different random numbers between 1 and 42 when I click on commandbutton2.
Right now, it gives the same random number in the 6 cells of my range.
Anybody can see where I went wrong?
Thanks a lot !

Blade Hunter
11-10-2010, 08:37 PM
Here is my code:
Private Sub CommandButton2_Click()
Dim randomnumbers As Range
Set randomnumbers = Range("E14:E19")
randomnumbers = Int((42 * Rnd) + 1)
End Sub
The problem is that I want 6 different random numbers between 1 and 42 when I click on commandbutton2.
Right now, it gives the same random number in the 6 cells of my range.
Anybody can see where I went wrong?
Thanks a lot !

Maybe loop through the cells instead of at a range level, test if the number exists in a previous cell, if it does then pick a new number.

mikerickson
11-10-2010, 08:40 PM
Did my response at
http://www.mrexcel.com/forum/showthread.php?t=508137
not work for you?

trevb
11-11-2010, 06:32 AM
You could use the code behind a button

HTH



Public counter As Integer, random_number(1 To 6) As Integer
Sub randomsix_generator()
'*******************************************
'* main routine for program *
'*******************************************
counter = 1 'reset variable
Do While (counter <= 6) 'loop for all 6 numbers
random_number(counter) = Int((42 * Rnd) + 1) 'random generate a number betwwen 1 and 42 inclusive
counter = counter + 1 'increment variable
If (counter > 2) Then 'if not first time
If (check_for_duplicate = True) Then 'check the number has not be previously generated
counter = counter - 1 'de-increment variable
End If
End If
Loop
bubble_sort random_number 'sort numbers sequentially
display_numbers 'output to screen
End Sub
Function check_for_duplicate() As Boolean
'*******************************************
'* sub-routine to check for duplicates *
'*******************************************
Dim check
For check = 1 To (counter - 2) 'loop for numbers generated so far
If random_number(counter - 1) = random_number(check) Then 'has the number been generated before
check_for_duplicate = True 'duplicate number found
Exit Function 'finish by terminating function
Else
check_for_duplicate = False 'duplicate number not found
End If
Next check
End Function
Sub bubble_sort(TempArray As Variant)
'*******************************************
'* sub-routine to sort all numbers *
'*******************************************
Dim Temp As Variant, i As Integer, NoExchanges As Integer 'declare variables
Do 'loop until all changes done
NoExchanges = True 'reset variable
For i = 1 To 5 'loop for appropriate numbers
If TempArray(i) > TempArray(i + 1) Then 'number is in the wrong order
NoExchanges = False 'reset variable
Temp = TempArray(i) 'temporary variable
TempArray(i) = TempArray(i + 1) 'move number to new position
TempArray(i + 1) = Temp 'move number to new position
End If
Next i
Loop While Not (NoExchanges)
End Sub
Sub display_numbers()
'*******************************************
'* sub-routine to output results *
'*******************************************
Dim i
For i = 1 To 6 'loop for all 6 numbers
Cells(i + 5, 5).Value = random_number(i) 'display to Excel spreadsheet
Next i
End Sub

Bob Phillips
11-11-2010, 07:27 AM
First, ensure cell A1 is empty and goto Tools>Options and on the Calculation
tab check the Iteration checkbox to stop the Circular Reference message.

Next, type this formula into cell E14
=IF(($A$1="")+(AND(E14>0,COUNTIF($E$14:$E$19,E14)=1)),E14,RANDBETWEEN(1,42))

it should show a 0

Copy E14 down to E19.

Finally, put some value in A1, say an 'x', and all the random numbers will
be generated, and they won't change.

To force a re-calculation, clear cell A1, edit cell E14, don't change it,
just edit to reset to 0, copy E14 down to E19, and re-input A1.

Kenneth Hobs
11-11-2010, 08:18 AM
You have several posts on this topic here and at other forums.

If you wanted to generate bingo cards, there are some specific examples to do that.

Here is yet another method to generate sequential sorted whole numbers.
Sub SetRandNums()
Dim i As Integer, idx As Integer, r As Range, f As Range, a()
Application.EnableEvents = False
Set f = Range("E14:E19")
f.Value2 = Empty
For Each r In f
idx = 0
Do Until idx = -1
a() = WorksheetFunction.Transpose(f)
i = WorksheetFunction.RandBetween(1, 42)
idx = Index(a, i)
Loop
r.Value = i
Next r
Application.EnableEvents = True
SortRange f
Set f = Nothing
End Sub

Function Index(vArray() As Variant, val As Variant) As Long
On Error GoTo Minus1
Index = WorksheetFunction.Match(val, WorksheetFunction.Transpose(vArray), 0)
Exit Function
Minus1:
Index = -1
End Function

Private Sub SortRange(fRange As Range)
Application.EnableEvents = False
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=fRange _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange fRange
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.EnableEvents = True
End Sub