Create a randomly sorted list from selected numbers

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am trying to achieve the following but have so far been unable to resolve.
I wish to create:
Multiple lists of 6 randomly sorted numbers from a selected range of numbers. ie
I have 12 different numbers. From this list of numbers, I want Excel to create 25 random lists of 6 numbers. The created lists must be different to each other.
Please Help???? I'm tearing my hair out.. Thanks
 
See the "Excel Programming" thread for answer to this question. I posted both the Excel worksheet function approach and the VBA approach.
 
Hi Guys,

Although both VBA examples and the formula example do
work, they also return repeated values in a single set of
6 numbers. A different approach that eliminates any
repeated values:

Put the values in say A1:A12. In B1:B12 enter this
formula: =RAND(). Now select the range A1:B12 and do a
sort on column B. Then you can take the first 6 values
from column A (A1:A6) as your randomly selected values
with no repeats.

Sorry I can't help with VBA code here but you could record
a macro to do this very easily and even assign it to a
button.

Biff
-----Original Message-----
See the "Excel Programming" thread for answer to this
Click to expand...
question. I posted both the Excel worksheet function
approach and the VBA approach.
 
Here's a tweak on one of Tom Ogilvy's routines, that will prompt you for how
many sets of numbers you want and how many numbers within each set. It's
currently set for values between 1 to 49 ( Yes it was a lottery draw :-> ), and
will not give any duplicates in any one set. To change the set of numbers it
pulls from just replace the 1 with your starting number and the 49 with your
finishing, and the 50 with 'your finishing number + 1':-

Option Explicit

Sub DrawNumbers()
'If you want unique random numbers, i.e. you want to shuffle the numbers 1 to 49
'
Dim i, choice, balls(1 To 49)
Dim lngArr(1 To 49) As Long
Dim RwNdx1 As Long
Dim RwNdx2 As Long
Dim ColNdx As Long
Dim ColW As Long
Dim lrow As Long
Dim cnt1 As Long
Dim cnt2 As Long
Dim temp As Long
Dim Rng As Range
Dim ar As Range
Dim cell As Range

ColW = ActiveSheet.UsedRange.Column - 1 + _
ActiveSheet.UsedRange.Columns.Count

lrow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count

' Clear the existing data first
Range("A1", Cells(lrow, ColW)).ClearContents
Range("A1").Select


cnt1 = InputBox("How many sets of numbers do you want?")
cnt2 = InputBox("How many numbers in each set do you want?")

If cnt2 > 49 Then
MsgBox ("You have asked for more numbers than you are pulling from - Try
again")
Call DrawNumbers
End If


RwNdx1 = 2
RwNdx2 = cnt2 + 1

For ColNdx = 1 To cnt1


Randomize
For i = 1 To 49
balls(i) = i
Next
For i = 1 To 49
choice = 1 + Int((Rnd * (49 - i)))
temp = balls(choice)
balls(choice) = balls(50 - i)
balls(50 - i) = temp
Next

i = 0

With Cells(RwNdx1 - 1, ColNdx)
.Value = "Set" & ColNdx
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With

Set Rng = Range(Cells(RwNdx1, ColNdx), Cells(RwNdx2, ColNdx))
For Each ar In Rng
For Each cell In ar
i = i + 1
cell.Value = balls(i)
Next
Next
Next ColNdx

Range("A1").Select

End Sub
 
Hi Max,

Nice one! Thanks for the update! I access through CDO and
haven't seen that posted there yet! One of the
disadvantages of CDO!

Biff
 
Back
Top