Random Generator

  • Thread starter Richard Champlin
  • Start date
R

Richard Champlin

Is it possible to create a random number generator that searches a list of
integers that are not consecutive, without generating a number that is not in
the list?

I would use it to randomly pick "X" number of items in a list to check for
inventory status, without having to verify that the random number generated
actually exists.
 
J

John Bundy

The best way is to pull it all into an array, then have a random number
generated that is one of the indexes of the array. If you can tell me more
about what sheet name and column the data is on and in what row and column I
can set something up for you if needed.
 
R

Richard Champlin

I have three columns of numbers, from Row 3 to row 863 (the last column is
shorter). Each column contains 5-digit integers. The first column contains
item numbers that are not consecutive, that start with 10009 and end with
11180, the second that start with 11181 and end with 21212, and the third
that start with 21213 and end with 29048. The numbers are not consecutive.
The reason for three columns is that these are filtered from a longer list
which is too long to allow a data filter to work.

How about if I e-mail you a copy?

Richard Champlin
Administrative Program Assistant II
Children's Hospital & Regional Medical Center, Seattle
 
J

John Bundy

Shoot it over. Are you wanting to select 1 item from each column or treat all
3 as one list?
 
S

Steve Yandl

Richard,

The sample subroutine below limits the random numbers to integers between 0
and 1000 but you can edit the high and low values. It looks at a list of
integers in Column A on the active sheet and generates random numbers in the
allowed range until a random number is created that isn't already recorded
in Column A. Finally, it adds the new random integer in the next available
cell at the bottom of Column A.

___________________________________

Sub NewRandInteger()
Dim rowTop As Integer
Dim rngInRowA As Range
Dim intRand As Integer
Dim Low As Double
Dim High As Double
Dim R As Double

Set objDict = CreateObject("Scripting.Dictionary")

rowTop = Range("A65536").End(xlUp).Row
Set rngInRowA = Range("A1:A" & rowTop)

For Each myCell In rngInRowA.Cells
intRand = myCell.Value
If Not objDict.Exists(intRand) Then
objDict.Add intRand, intRand
End If
Next myCell

High = 1000
Low = 0

R = Range("A1").Value

Do Until Not objDict.Exists(R)
R = Int((High - Low + 1) * Rnd() + Low)
Loop

Range("A" & rowTop + 1).Value = R

End Sub

____________________________________

Steve
 
S

Steve Yandl

I just read your question again and think I gave you the opposite of what
you wanted. A slight modification could make it do what you want.

Steve


Steve Yandl said:
Richard,

The sample subroutine below limits the random numbers to integers between
0 and 1000 but you can edit the high and low values. It looks at a list
of integers in Column A on the active sheet and generates random numbers
in the allowed range until a random number is created that isn't already
recorded in Column A. Finally, it adds the new random integer in the next
available cell at the bottom of Column A.

___________________________________

Sub NewRandInteger()
Dim rowTop As Integer
Dim rngInRowA As Range
Dim intRand As Integer
Dim Low As Double
Dim High As Double
Dim R As Double

Set objDict = CreateObject("Scripting.Dictionary")

rowTop = Range("A65536").End(xlUp).Row
Set rngInRowA = Range("A1:A" & rowTop)

For Each myCell In rngInRowA.Cells
intRand = myCell.Value
If Not objDict.Exists(intRand) Then
objDict.Add intRand, intRand
End If
Next myCell

High = 1000
Low = 0

R = Range("A1").Value

Do Until Not objDict.Exists(R)
R = Int((High - Low + 1) * Rnd() + Low)
Loop

Range("A" & rowTop + 1).Value = R

End Sub

____________________________________

Steve
 
R

Richard Champlin

What I do is select up to 20 items, some from each column. You could put
them all in one column, because as I said, three columns was simply to work
around the data filter limitations.

What is your e-mail address?
 
R

Richard Champlin

Be aware, I am a novice when it comes to writing routines. I recently
started creating macros, then debugging using Visual Basic. I am unfamiliar
with the language syntax. Could I take the subroutine you provided and
simply paste it into a new VB document to create a routine?
--
Richard Champlin
Administrative Program Assistant II
Children''''''''s Hospital & Regional Medical Center, Seattle


Steve Yandl said:
Richard,

The sample subroutine below limits the random numbers to integers between 0
and 1000 but you can edit the high and low values. It looks at a list of
integers in Column A on the active sheet and generates random numbers in the
allowed range until a random number is created that isn't already recorded
in Column A. Finally, it adds the new random integer in the next available
cell at the bottom of Column A.

___________________________________

Sub NewRandInteger()
Dim rowTop As Integer
Dim rngInRowA As Range
Dim intRand As Integer
Dim Low As Double
Dim High As Double
Dim R As Double

Set objDict = CreateObject("Scripting.Dictionary")

rowTop = Range("A65536").End(xlUp).Row
Set rngInRowA = Range("A1:A" & rowTop)

For Each myCell In rngInRowA.Cells
intRand = myCell.Value
If Not objDict.Exists(intRand) Then
objDict.Add intRand, intRand
End If
Next myCell

High = 1000
Low = 0

R = Range("A1").Value

Do Until Not objDict.Exists(R)
R = Int((High - Low + 1) * Rnd() + Low)
Loop

Range("A" & rowTop + 1).Value = R

End Sub

____________________________________

Steve
 
R

Richard Champlin

Thank you sir, this worked perfectly. I know it sounds uneducated, but it
is: what does the +1 do at the end of the formula? I simply changed the 100
to the last row in the list, and changed the last number in the formula to
match. What effect would it be to change the +1 to a +2, etc?
 
J

JE McGimpsey

RAND() generates a value greater than or equal to 0, and less than 1. So
when multiplied by, say, 100 rows, the values returned will be in the
range 0 to 99.999999999999999.

Index truncates the result of the calculations, so to get rows 1 to 100,
one needs to add 1 to the 0 to 99 range.
 
C

Chip Pearson

Try the following function.


Function RandsFromRange(InputRange As Range, GetNum As Long) As Variant()
Dim Res() As Variant
Dim Ins() As Variant
Dim TopNdx As Long
Dim Ndx As Long
Dim N As Long

ReDim Res(1 To InputRange.Cells.Count)
Ins = InputRange.Value
TopNdx = UBound(Res)
For N = 1 To GetNum
Ndx = Int(TopNdx * Rnd + 1)
Res(N) = Ins(Ndx, 1)
TopNdx = TopNdx - 1
Next N
If IsObject(Application.Caller) = True Then
If TypeOf Application.Caller Is Excel.Range Then
If Application.Caller.Columns.Count = 1 Then
RandsFromRange = Application.Transpose(Res)
Else
RandsFromRange = Res
End If
Else
' do nothing
End If
Else
RandsFromRange = Res
End If

End Function


You can call it from a worksheet cells with a formula like
=RandsFromRange(A1:A10,5) where A1:A10 is the range of values to pick from
and 5 is the number of value to return in random order. Modify the
parameters to suit your needs. See also
http://www.cpearson.com/Excel/randomNumbers.aspx . Values will be taken from
A1:A10 with no repeats in the returned set (assuming that the source range
A1:A10 has no duplicate entries).


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)
 
C

Chip Pearson

Bug in the code I posted. Use the following instead:

Function RandsFromRange(InputRange As Range, GetNum As Long) As Variant
Dim ResultArr() As Variant
Dim SourceArr() As Variant
Dim TopNdx As Long
Dim ResultNdx As Long
Dim SourceNdx As Long
Dim Temp As Variant

If InputRange.Columns.Count > 1 And InputRange.Rows.Count > 1 Then
RandsFromRange = CVErr(xlErrRef)
Exit Function
End If

If GetNum > InputRange.Cells.Count Then
RandsFromRange = CVErr(xlErrValue)
Exit Function
End If

ReDim ResultArr(1 To InputRange.Cells.Count)
SourceArr = InputRange.Value
Randomize
TopNdx = UBound(ResultArr)
For ResultNdx = LBound(ResultArr) To UBound(ResultArr)
SourceNdx = Int(TopNdx * Rnd + 1)
ResultArr(ResultNdx) = SourceArr(SourceNdx, 1)
Temp = SourceArr(SourceNdx, 1)
SourceArr(SourceNdx, 1) = SourceArr(TopNdx, 1)
SourceArr(TopNdx, 1) = Temp
TopNdx = TopNdx - 1
Next ResultNdx

If IsObject(Application.Caller) = True Then
If TypeOf Application.Caller Is Excel.Range Then
If Application.Caller.Columns.Count = 1 Then
RandsFromRange = Application.Transpose(ResultArr)
Else
RandsFromRange = ResultArr
End If
Else
' do nothing
End If
Else
RandsFromRange = ResultArr
End If

End Function


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)

Chip Pearson said:
Try the following function.


Function RandsFromRange(InputRange As Range, GetNum As Long) As Variant()
Dim Res() As Variant
Dim Ins() As Variant
Dim TopNdx As Long
Dim Ndx As Long
Dim N As Long

ReDim Res(1 To InputRange.Cells.Count)
Ins = InputRange.Value
TopNdx = UBound(Res)
For N = 1 To GetNum
Ndx = Int(TopNdx * Rnd + 1)
Res(N) = Ins(Ndx, 1)
TopNdx = TopNdx - 1
Next N
If IsObject(Application.Caller) = True Then
If TypeOf Application.Caller Is Excel.Range Then
If Application.Caller.Columns.Count = 1 Then
RandsFromRange = Application.Transpose(Res)
Else
RandsFromRange = Res
End If
Else
' do nothing
End If
Else
RandsFromRange = Res
End If

End Function


You can call it from a worksheet cells with a formula like
=RandsFromRange(A1:A10,5) where A1:A10 is the range of values to pick from
and 5 is the number of value to return in random order. Modify the
parameters to suit your needs. See also
http://www.cpearson.com/Excel/randomNumbers.aspx . Values will be taken
from A1:A10 with no repeats in the returned set (assuming that the source
range A1:A10 has no duplicate entries).


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)
 
R

Richard Champlin

Chip,

Thanks a lot. I have been so busy. Another poster's idea seemed to work,
though it's a pain in that I have to close and reopen the file every time I
want to use the macro.
--
Richard Champlin
Administrative Program Assistant II
Children''''''''s Hospital & Regional Medical Center, Seattle


Chip Pearson said:
Bug in the code I posted. Use the following instead:

Function RandsFromRange(InputRange As Range, GetNum As Long) As Variant
Dim ResultArr() As Variant
Dim SourceArr() As Variant
Dim TopNdx As Long
Dim ResultNdx As Long
Dim SourceNdx As Long
Dim Temp As Variant

If InputRange.Columns.Count > 1 And InputRange.Rows.Count > 1 Then
RandsFromRange = CVErr(xlErrRef)
Exit Function
End If

If GetNum > InputRange.Cells.Count Then
RandsFromRange = CVErr(xlErrValue)
Exit Function
End If

ReDim ResultArr(1 To InputRange.Cells.Count)
SourceArr = InputRange.Value
Randomize
TopNdx = UBound(ResultArr)
For ResultNdx = LBound(ResultArr) To UBound(ResultArr)
SourceNdx = Int(TopNdx * Rnd + 1)
ResultArr(ResultNdx) = SourceArr(SourceNdx, 1)
Temp = SourceArr(SourceNdx, 1)
SourceArr(SourceNdx, 1) = SourceArr(TopNdx, 1)
SourceArr(TopNdx, 1) = Temp
TopNdx = TopNdx - 1
Next ResultNdx

If IsObject(Application.Caller) = True Then
If TypeOf Application.Caller Is Excel.Range Then
If Application.Caller.Columns.Count = 1 Then
RandsFromRange = Application.Transpose(ResultArr)
Else
RandsFromRange = ResultArr
End If
Else
' do nothing
End If
Else
RandsFromRange = ResultArr
End If

End Function


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)
 
M

Mike Middleton

Richard Champlin -

The RandSample function (one of the random number generator functions in the
RiskSim add-in for Monte Carlo simulation) will select a sample without
replacement from a single row or column of values. You can download a free
tryout version and user guide from www.treeplan.com.

- Mike Middleton
http://www.DecisionToolworks.com
Decision Analysis Add-ins for Excel
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top