Help with loop & marco

[AC]

Hi, just trying to learn some VBA and need some help, the code below will generate a set of 5 unique random numbers, I would like the code to run a number of times, loop I guess, I would like to have and input box come up and ask how many sets of numbers you want, 1 would give you 1 set of five numbers 10 would give you 10 sets of 5 numbers. It would also be helpful if the code could be changed to put the numbers in a row instead of in a column, right now the numbers go in A1:A5 I would prefer them to be in A1:E5 and the next set to go in C1:C5, and so on. I look forward to seeing how this can be done so I can learn from it. Thanks

Sub GenNUniqueRandom()
'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139 [Algorithm P]
'
'
Dim list() As Long
Dim list1() As Long
Dim t As Long
Dim num As Long
'Number of Unique Random Numbers you need
num = 5
'From a list of 1 to t numbers
t = 52
ReDim list(1 To t)
For i = 1 To t
list(i) = i
Next
j = t
Randomize
For i = 1 To t
k = Rnd() * j + 1
lngTemp = list(j)
list(j) = list(k)
list(k) = lngTemp
j = j - 1
Next
ReDim list1(1 To num)
For k = 1 To num
list1(k) = list(k)
Next
Range(Cells(1, 1), Cells(num, 1)).Value = Application.Transpose(list1)
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(2, 0).Select

End Sub

[Jack in the UK]

This will not answer your question but offers smaller code so you can link a input box to the number of different randon numbers you want, and so only need few changes, might have a play later

This was given to me by my great friend Dave Hawley in Western Australia.

I have also returned the favour to Dave with my code which looks for numbers rather than produces them, I have sent this to many friends Chris you have this please can you email me my own work save re doing here as I don’t have at home ill edit for this guy if I can..

Have some fun..

I like very short codes.. so this might make it easier… and will be easy to adapt

Just offering some other approach…



Sub RandomNumberGenerator()
'Creates a list of random numbers _
between 1 and 36 in range A1:F6
'Written by OzGrid Business Applications
'www.ozgrid.com
Dim Rw As Integer, Col As Integer
'Clear the range ready for random numbers
Range("A1:B18").Clear
Randomize ' Initialize random-number generator.
For Col = 1 To 2 'Set the Column numbers
For Rw = 1 To 18 'Set the Row numbers
'
Cells(Rw, Col) = Int((36 * Rnd) + 1)
Do Until WorksheetFunction.CountIf _
(Range("A1:B18"), Cells(Rw, Col)) = 1
Cells(Rw, Col) = Int((36 * Rnd) + 1)
Loop

Next Rw
Next Col
End Sub

[Nimrod]

Is this what you looking for ?

Public Sub LoopExample()
SmallestNum = 1 ' smallest random number
LargestNum = 100 ' largest random number

' Ask user for number of sets required
NumOfSets = InputBox("how many sets of numbers you want", "How Many Numbers")

' Create the sets
For SetCount = 1 To NumOfSets
    For LoopCount = 1 To 5
        RandNum = Int((LargestNum * Rnd) + SmallestNum)
        Cells(SetCount, LoopCount).Value = RandNum
    Next 'loopcount
Next ' next set

End Sub

[Nimrod]

Version 2: Not as coder friendly but works

Public Sub LoopExample()
For SetCount = 1 To (InputBox("how many sets of numbers you want", "How Many Numbers"))
    For LoopCount = 1 To 5
        RandNum = Int((99 * Rnd) + 1)
        Cells(SetCount, LoopCount).Value = RandNum
    Next 'loopcount
Next ' next set
End Sub

Version 3:

Public Sub RandomNum()
For SetCount = 1 To (InputBox("how many sets of numbers you want", "How Many Numbers"))
    For LoopCount = 1 To 5
        Cells(SetCount, LoopCount).Value = (Int((99 * Rnd) + 1))
    Next 'loopcount
Next ' next set
End Sub

_________________
NOTE: Testing performed on Win2K utilizing Office 2000. Solutions may need tweaking for other versions.

[ This Message was edited by: Nimrod on 2002-05-14 15:36 ]

[AC]

Nirod,I am trying to see how this works, I am looking at the first code you posted, this works but sometime has duplicates numbers, I need unique numbers, can this difficulty be addressed? Thanks for your help

[Nimrod]

Hi AC:
Sure just put the word "Randomize" at the top of the procedure.

I've just made up two more versions fot you to look at .

This first one has no bells and whistles but meets the requirements.

Public Sub RandNum()
    For Each c In Range("A1:E" & (InputBox("how many sets?")))
        c.Value = (Int((99 * Rnd) + 1))
    Next c
End Sub

This next one does everything the first one does Plus: make sure random numbers are different and clears the sheet before putting the numbers in.

Public Sub RandNum3()
    Randomize
    Cells.Clear
    For Each c In Range("A1:E" & (InputBox("how many sets?")))
            c.Value = (Int((99 * Rnd) + 1))
    Next c
End Sub

I'm going to try to get it smaller.... I'll let you know if I can.

Cheers

[NateO]

Randomize starts XL's random number generator, but does not ensure uniqueness. You'll need to create the number and loop through the range to ensure uniqueness as below.

Option Explicit

Sub Ran()

Dim upr As Integer, lwr As Integer

Dim upr2 As Integer, lwr2 As Integer, cell As Range

Dim LastRow As Long, myrng As Range, c As Range

Dim SearchValue As String

upr = 9999 'upper1 integer limit

lwr = 1000 'lower1 integer limit

upr2 = 10 'upper1 integer limit

lwr2 = 99 'lower1 integer limit

Application.ScreenUpdating = False

For Each cell In [a1:a500]

Randomize

cell.Value = Int((upr - lwr + 1) * Rnd + lwr) & "8" _

& Int((upr2 - lwr2 + 1) * Rnd + lwr2) & "1"

test: 'For uniqueness that is

LastRow = cell.Row - 1

If LastRow = 0 Then GoTo 1

Set myrng = Range("a1:a" & LastRow)

Set c = Range("A1:A" & LastRow).Find(what:=cell.Value, _

    LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then

    [a65536].End(xlUp) = Int((upr - lwr + 1) * Rnd + lwr) & "8" _

    & Int((upr2 - lwr2 + 1) * Rnd + lwr2) & "1"

    GoTo test

End If

Set myrng = Nothing

Set c = Nothing

1:

Next cell

Application.ScreenUpdating = True

End Sub

I'd rewrite this but I'm at a thin client and have no Xl or VBE access. Just looking to provide methodology.

Change .row to .column, use cells(x,y), etc....

_________________
Cheers, NateO

[ This Message was edited by: NateO on 2002-05-14 18:19 ]

[Jay Petrulis]

Hi,

For your learning, I have rewritten Tom Ogilvy's code you originally reposted to list the random numbers in a row, not down a column.

Also, I threw the whole routine into a loop so you can do it 20 times at one shot.

These types of questions are terrific. Study this code, and Nimrod's and Nate0's and Dave Hawley's that Jack posted, and you'll really learn a ton. This board has had numerous lively discussions about random numbers, so you have ample study material.

If you have a specific question about the workings of the code, please ask.

Sub GenNUniqueRandom()
'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139 [Algorithm P]
'
'
Dim list() As Long
Dim list1() As Long
Dim t As Long, i As Long, j As Long, k As Long
Dim num As Long, lngTemp, nextrow As Long
Dim x As Long

For x = 1 To 20
    'Number of Unique Random Numbers you need
    num = 5
    'From a list of 1 to t numbers
    t = 52
    ReDim list(1 To t)
    For i = 1 To t
        list(i) = i
    Next i
    j = t
    Randomize
    For i = 1 To t
        k = Rnd() * j + 1
        lngTemp = list(j)
        list(j) = list(k)
        list(k) = lngTemp
        j = j - 1
    Next i
    ReDim list1(1 To num)
    For k = 1 To num
        list1(k) = list(k)
    Next k
    nextrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Range(Cells(nextrow, 1), Cells(nextrow, num)).Value = list1
Next x
End Sub

Bye,
Jay

P.S. Jack, please post your version when you can. The more options and ideas offered, the better.

Bye,
Jay

[Nimrod]

Ok the ranomize didn't do as much as I thought it would so here's one that makes sure every cell is unique.
HOWEVER: realize your going to have a problem if you ask for more then 20 sets...
since this generator has only been assign a value from 1-100.
Might I suggest we change the code so that the unique number requirement is only for each row of numbers ?

Public Sub RandNum4()
    Randomize
    Cells.Clear
    Rw = (InputBox("how many sets?"))
    For Each c In Range("A1:E" & Rw)
TryAgain:
            c.Value = (Int((100 * Rnd) + 1))
            For Each t In Range("A1:E" & Rw)
              If Not t.Address = c.Address And t.Value = c.Value Then GoTo TryAgain
            Next t
    Next c
End Sub

If you want a larger range of numbers just change the number 1 and 100 in the Rnd command i.e. 1 is smallest number and 100 the largest.

Another way to avoid running out of unique numbers is to replace the [100] with a formula that is depended on the number of sets requested i.e. 100x Rw would give a range of 500 numbers for 5 sets. This way way your number pool increases with the number of sets requested.

Public Sub RandNum4()
    Randomize
    Cells.Clear
    Rw = (InputBox("how many sets?"))
    For Each c In Range("A1:E" & Rw)
TryAgain:
            c.Value = (Int(((100 * Rw) * Rnd) + 1))
            For Each t In Range("A1:E" & Rw)
              If Not t.Address = c.Address And t.Value = c.Value Then GoTo TryAgain
            Next t
    Next c
End Sub

[ This Message was edited by: Nimrod on 2002-05-14 19:14 ]

[AC]

Nimrod, yes please change the code so that the unique number requirement is only for each row of numbers, that is what I need, not for ALL the numbers to be unique just each row. Thanks



[ This Message was edited by: ac on 2002-05-14 19:21 ]