I work in a hospital and I have a worksheet of data from the patients we
treat. One column has their ID number and I want to add a column next to this
to which I can add a series of random numbers as a security measure when
passing data to different departments. I have read a number of threads on
this site and feel comfortable in generating the unique random numbers
(thanks to Bernd Plumoff's UDF). But what I can't seem to manage is to keep
this column of unique random numbers from updating, which defeats the
purpose. I realise I can just use RAND() and then hit F9 to turn this into a
random number but I need to be sure sure that this rather tedious method
(when doing it for 2000 records) will not produce duplicate records.

I need to be able to generate a column of randomly assigned, unique
integers, in a number range that I can specify and that are not updated once
they have been generated.

Thank you for any suggestions,
Ian.

Here is one technique

First, ensure cell A1 is empty and goto ToolsOptions and on the Calculation
tab check the Iteration checkbox to stop the Circular Reference message.

Next, type this formula into cell B1
=IF(($A$1="")+(AND(B10,COUNTIF($B$1:$B$2000,B1)=1 )),B1,INT(RAND()*2000+1))
it should show a 0

Copy B1 down to B2000.

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 B1, don't change it,
just edit to reset to 0, copy B1 down to B2000, and re-input A1.


Obviously, A1 can be any cell that you want.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Ian" wrote in message
...
I work in a hospital and I have a worksheet of data from the patients we
treat. One column has their ID number and I want to add a column next to
this
to which I can add a series of random numbers as a security measure when
passing data to different departments. I have read a number of threads on
this site and feel comfortable in generating the unique random numbers
(thanks to Bernd Plumoff's UDF). But what I can't seem to manage is to
keep
this column of unique random numbers from updating, which defeats the
purpose. I realise I can just use RAND() and then hit F9 to turn this into
a
random number but I need to be sure sure that this rather tedious method
(when doing it for 2000 records) will not produce duplicate records.

I need to be able to generate a column of randomly assigned, unique
integers, in a number range that I can specify and that are not updated
once
they have been generated.

Thank you for any suggestions,
Ian.

"Ian" skrev i en meddelelse
...
I work in a hospital and I have a worksheet of data from the patients we
treat. One column has their ID number and I want to add a column next to
this
to which I can add a series of random numbers as a security measure when
passing data to different departments. I have read a number of threads on
this site and feel comfortable in generating the unique random numbers
(thanks to Bernd Plumoff's UDF). But what I can't seem to manage is to
keep
this column of unique random numbers from updating, which defeats the
purpose. I realise I can just use RAND() and then hit F9 to turn this into
a
random number but I need to be sure sure that this rather tedious method
(when doing it for 2000 records) will not produce duplicate records.

I need to be able to generate a column of randomly assigned, unique
integers, in a number range that I can specify and that are not updated
once
they have been generated.

Thank you for any suggestions,
Ian.

Hi Ian

Here's a VBA solution, which inserts a random number, when you doubleclick
a cell in one of the defined ranges.

In the sheet:

1. Rightclick the sheet tab and choose "View code" (or similar)
2. Copy the code "Private Sub Worksheet_BeforeDoubleClick" below
3. Paste it to the righthand window.

The code defines a random number of ranges on this sheet, with their own
pools of random numbers.
E.g. Array("B2:B2000", 100, 10000) defines the range "B2:B2000" with random
numbers 100 through 10000. You can add your own ranges using the set up
shown below.
For one range: RandData = Array(Array("B2:B2000", 100, 10000))


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
'Leo Heuser, 18 Sep. 2006
Dim Answer As Variant
Dim CheckRange As Range
Dim Counter As Long
Dim RandData As Variant
Dim FirstNum As Long
Dim LastNum As Long

' RandData: Array(Range, FirstNumber, LastNumber)
' Range must be in this sheet.

RandData = Array(Array("B2:B2000", 100, 10000), _
Array("F15:F23", 3, 11), _
Array("G1:H6", 2, 13))

For Counter = LBound(RandData) To UBound(RandData)
Set CheckRange = Range(RandData(Counter)(LBound(RandData)))
If Not Intersect(Target, CheckRange) Is Nothing Then
If Target.Cells.Count 1 Then Exit Sub
Cancel = True

If Not (IsEmpty(Target)) Then
Answer = MsgBox("Do you want a new random number?", _
vbDefaultButton2 + vbYesNo)
If Answer < vbYes Then Exit Sub
End If

Target.Value = NewRandNum(CheckRange, _
RandData(Counter)(LBound(RandData) + 1), _
RandData(Counter)(LBound(RandData) + 2))
End If
Next Counter
End Sub



4. Choose Insert Module
5. Copy the code below and paste it to the righthand window


Function NewRandNum(Randrange As Range, FirstNum As Variant, _
LastNum As Variant) As Long
'Leo Heuser, 18 Sep. 2006
'When a number is inserted in a cell, it's not updated ever,
'and it is removed from the random number pool for that range.
Dim Counter As Long
Dim Counter1 As Long
Dim RandCol As New Collection
Dim RandRangeValue As Variant

Randomize

RandRangeValue = Randrange.Value

On Error Resume Next

For Counter = FirstNum To LastNum
RandCol.Add Item:=Counter, key:=CStr(Counter)
Next Counter

For Counter = 1 To UBound(RandRangeValue, 1)
For Counter1 = 1 To UBound(RandRangeValue, 2)
If Not (IsEmpty(RandRangeValue(Counter, Counter1))) Then
RandCol.Add Item:=RandRangeValue(Counter, Counter1), _
key:=CStr(RandRangeValue(Counter, Counter1))
If Err.Number < 0 Then
RandCol.Remove CStr(RandRangeValue(Counter, Counter1))
Err.Number = 0
End If
End If
Next Counter1
Next Counter

RandNum = Int(Rnd() * RandCol.Count) + 1

NewRandNum = RandCol(RandNum)

On Error GoTo 0

End Function


6. Return to the sheet with <Alt<F11 and save the workbook.

Ready to go :-)


--
Best regards
Leo Heuser

Followup to newsgroup only please.

What is the relationship between the number of records
and the number of iterations I have to do?
I tried 400 records and, in the formula, changed 2000 to 400.
I had to iterate 625 times before the numbers became unique.

I am afraid that I don't know, it has always been trial and error with me.
Perhaps someone else does know.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Herbert Seidenberg" wrote in message
oups.com...
What is the relationship between the number of records
and the number of iterations I have to do?
I tried 400 records and, in the formula, changed 2000 to 400.
I had to iterate 625 times before the numbers became unique.

"Leo Heuser" wrote:
.. You can add your own ranges using the set up shown below.
For one range: RandData = Array(Array("B2:B2000", 100, 10000))

Great sub, Leo !

Is there a simple way to bring over to Excel screen via say, an inputbox, so
that we can define the clickable ranges and the numeric limits below in Excel
itself ?

RandData = Array(Array("B2:B2000", 100, 10000), _
Array("F15:F23", 3, 11), _
Array("G1:H6", 2, 13))

Thanks
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

Max,

Set rng = Application.Inputbox("Select range", Type:=8)

allows the selection of a range mid-macro, and a couple more inputboxes
could be added to get the limits, but that sounds like it would be better to
throw up a simple form to get the details, easier to control.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Max" wrote in message
...
"Leo Heuser" wrote:
.. You can add your own ranges using the set up shown below.
For one range: RandData = Array(Array("B2:B2000", 100, 10000))

Great sub, Leo !

Is there a simple way to bring over to Excel screen via say, an inputbox,
so
that we can define the clickable ranges and the numeric limits below in
Excel
itself ?

RandData = Array(Array("B2:B2000", 100, 10000), _
Array("F15:F23", 3, 11), _
Array("G1:H6", 2, 13))

Thanks
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

Bob, thanks. Any chance of a sample to work it here for study? Think I'm not
vba-versed sufficiently to fashion it out <g. Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Bob Phillips" wrote in message
...
Max,

Set rng = Application.Inputbox("Select range", Type:=8)

allows the selection of a range mid-macro, and a couple more inputboxes
could be added to get the limits, but that sounds like it would be better
to
throw up a simple form to get the details, easier to control.

Hello Ian,

If you need them only once you can create the unique random integers
with my function UniqRandInt, then select them, push CTLR + c, then ALT
+ e, s, v (copy and paste by values).

Or - if you need this functionality more often - you can:
1. Define a named range "MyCount" for a cell where you enter how many
numbers you want to get. Enter 10 into E1, for example, select E1 and
define that range with Insert/Name/Define.
2. Define a named range "MyRange" for a cell where you specify the max
random number you want to get. Take E2 and enter 20, for example (has
to be = 10!).
3. Define a named range "MyTarget" for a range of cells where you want
the output to be written to. Select E4:E13, for example.
4. Then put my function VBUniqRandInt into a module together with this
sub:
Sub Constant_UniqRandInts()
Dim lr As Long
Dim lc As Long

lr = Range("MyRange")
lc = Range("MyCount")

If Range("MyTarget").Columns.Count 1 Then
Range("MyTarget") = VBUniqRandInt(lc, lr)
Else
Range("MyTarget") =
Application.WorksheetFunction.Transpose(VBUniqRand Int(lc, lr))
End If

End Sub

5. Insert a Push Button into your spreadsheet and connect it to the sub
Constant_UniqRandInts

6. Fire off that button. The random numbers won't change on hitting F9
- just when you push the button.

HTH,
Bernd

I have left Leo's random number generator function alone (although the way
that I am doing it, you could probably remove the need to pass the range
through), and I had to declare RandNum in it as I always use Option
Explicit.

Sub GenerateRandoms()
Dim rng As Range
Dim cell As Range
Dim FirstNum
Dim LastNum

Set rng = Application.InputBox(prompt:="Select range", Type:=8)
If rng Is Nothing Then Exit Sub
FirstNum = InputBox("Provide the starting number")
If FirstNum = "" Then Exit Sub
LastNum = InputBox("Provide the final number")
If LastNum = "" Then Exit Sub

For Each cell In rng
cell.Value = NewRandNum(rng, FirstNum, LastNum)
Next cell

End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Max" wrote in message
...
Bob, thanks. Any chance of a sample to work it here for study? Think I'm
not
vba-versed sufficiently to fashion it out <g. Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Bob Phillips" wrote in message
...
Max,

Set rng = Application.Inputbox("Select range", Type:=8)

allows the selection of a range mid-macro, and a couple more inputboxes
could be added to get the limits, but that sounds like it would be
better
to
throw up a simple form to get the details, easier to control.

Thanks very much to Bob, Leo and Bernd, some excellent solutions to my
problem. I'm working through all the solutions to find the best for my
particular problem. Thanks again and thanks to this forum.

Ian.

" wrote:

Hello Ian,

If you need them only once you can create the unique random integers
with my function UniqRandInt, then select them, push CTLR + c, then ALT
+ e, s, v (copy and paste by values).

Or - if you need this functionality more often - you can:
1. Define a named range "MyCount" for a cell where you enter how many
numbers you want to get. Enter 10 into E1, for example, select E1 and
define that range with Insert/Name/Define.
2. Define a named range "MyRange" for a cell where you specify the max
random number you want to get. Take E2 and enter 20, for example (has
to be = 10!).
3. Define a named range "MyTarget" for a range of cells where you want
the output to be written to. Select E4:E13, for example.
4. Then put my function VBUniqRandInt into a module together with this
sub:
Sub Constant_UniqRandInts()
Dim lr As Long
Dim lc As Long

lr = Range("MyRange")
lc = Range("MyCount")

If Range("MyTarget").Columns.Count 1 Then
Range("MyTarget") = VBUniqRandInt(lc, lr)
Else
Range("MyTarget") =
Application.WorksheetFunction.Transpose(VBUniqRand Int(lc, lr))
End If

End Sub

5. Insert a Push Button into your spreadsheet and connect it to the sub
Constant_UniqRandInts

6. Fire off that button. The random numbers won't change on hitting F9
- just when you push the button.

HTH,
Bernd

Thanks for the example, Bob. Runs great!
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Bob Phillips" wrote:
I have left Leo's random number generator function alone (although the way
that I am doing it, you could probably remove the need to pass the range
through), and I had to declare RandNum in it as I always use Option
Explicit.

Sub GenerateRandoms()
Dim rng As Range
Dim cell As Range
Dim FirstNum
Dim LastNum

Set rng = Application.InputBox(prompt:="Select range", Type:=8)
If rng Is Nothing Then Exit Sub
FirstNum = InputBox("Provide the starting number")
If FirstNum = "" Then Exit Sub
LastNum = InputBox("Provide the final number")
If LastNum = "" Then Exit Sub

For Each cell In rng
cell.Value = NewRandNum(rng, FirstNum, LastNum)
Next cell

End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Max" skrev i en meddelelse
...

Great sub, Leo !

Is there a simple way to bring over to Excel screen via say, an inputbox,
so
that we can define the clickable ranges and the numeric limits below in
Excel
itself ?



Thanks Max!

Here's ver.2 with more options.

The Rand data is now set up in a named table in the proper worksheet(s).
The random numbers are still fetched by doubleclicking a cell, but you now
have a choice of filling one cell or all cells.

The name must be "RandTable" (without quotes) and it must be local, so
in sheet1 the name is sheet1!RandTable, in sheet2 the name is
sheet2!RandTable etc.

For example my named range is H2:L12 (H1:L1 contains headings).

Not all rows in the range need to be filled, but blank rows must not exist
between filled rows. H2:L6 could contain definitions with empty cells in
H7:L12, which is OK.
H2:L6 and H9:L9 containing definitions and H7:L8 being empty is
not allowed.

The table has 5 columns with these headings:
Column 1: Range
Column 2: First number
Column 3: Last number
Column 4: Step
Column 5: All cells

Examples:

B2:B6 2 60 2 yes
G20:K100 5 1000 3

B2:B6 will be filled with even numbers in the range 2 - 60 (inclusive).
Step 2 means, that the random numbers will be 2,4,6,8,10,.....,60.
The "yes" in column 5 means, that doubleclicking a cell in B2:B6 will
fill all cells at once. If the cell in column 5 is empty, a click will only
fill the clicked cell.
The "yes" could have been anything (true, 1 etc). As long as the cell
is *not empty*, all cells in the range will be filled immediately.

The second example has a pool of random numbers consisting of
5,8,11,14,17,.........
Doubleclicking a cell in G20:K100 will only fill this cell.

Doubleclicking a filled cell, will ask you, if you want a new number(s).

There's no limit to the number of RandRanges.

The below sub "Worksheet_BeforeDoubleClick" is inserted by copying
the code, rightclicking the sheet tab and paste to the righthand window.

The same code can be inserted from more sheets at the same time.
The important thing is, that the RandTables are named *locally* as
described above.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
'Leo Heuser, 20 Sep. 2006, ver. 2
Dim Answer As Variant
Dim Cell As Range
Dim Counter As Long
Dim Counter1 As Long
Dim DummyRange As Range
Dim RandData As Variant
Dim RandRange As Range
Dim RandTableRange As Range
Dim RandTableValue As Variant
Dim RandTableName As String

RandTableName = "RandTable"

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)
Set RandTableRange = RandTableRange. _
Resize(Application.CountA(RandTableRange.Columns(1 )))

RandData = RandTableRange.Value

For Counter = LBound(RandData, 1) To UBound(RandData, 1)
Set RandRange = Range(RandData(Counter, 1))

If Not Intersect(Target, RandRange) Is Nothing Then
If Target.Cells.Count 1 Then Exit Sub

Cancel = True

If Not (IsEmpty(Target)) Then
Answer = MsgBox("Do you want a new random number(s)?", _
vbDefaultButton2 + vbYesNo)
If Answer < vbYes Then Exit Sub
End If

If IsEmpty(RandData(Counter, 5)) Then
Set DummyRange = Target
Else
RandRange.ClearContents
Set DummyRange = RandRange
End If

For Each Cell In DummyRange.Cells
Cell.Value = NewRandNum(RandRange, _
RandData(Counter, 2), _
RandData(Counter, 3), _
RandData(Counter, 4))
Next Cell

Exit Sub
End If
Next Counter
End Sub


The code below is inserted in a general module.
(<Alt<F11, Insert Module)


Function NewRandNum(RandRange As Range, FirstNum As Variant, _
LastNum As Variant, StepValue As Variant) As Variant
'Leo Heuser, 20 Sep. 2006, ver. 2
'When a number is inserted in a cell, it's not updated ever,
'and it is removed from the random number pool of that range.
'If a number is deleted from a cell, it's automatically added
'to the pool of that range.
Dim Counter As Double
Dim Counter1 As Long
Dim RandCol As New Collection
Dim RandNum As Long
Dim RandRangeValue As Variant

Randomize

RandRangeValue = RandRange.Value

On Error Resume Next

If LastNum < FirstNum Then
StepValue = -Abs(StepValue)
Else
StepValue = Abs(StepValue)
End If

For Counter = FirstNum To LastNum Step StepValue
RandCol.Add Item:=Counter, key:=CStr(Counter)
Next Counter

For Counter = 1 To UBound(RandRangeValue, 1)
For Counter1 = 1 To UBound(RandRangeValue, 2)
If Not (IsEmpty(RandRangeValue(Counter, Counter1))) Then
RandCol.Add Item:=RandRangeValue(Counter, Counter1), _
key:=CStr(RandRangeValue(Counter, Counter1))
If Err.Number < 0 Then
RandCol.Remove _
CStr(RandRangeValue(Counter, Counter1))
Err.Number = 0
End If
End If
Next Counter1
Next Counter

RandNum = Int(Rnd() * RandCol.Count) + 1

NewRandNum = RandCol(RandNum)

On Error GoTo 0

End Function


Cheers
Leo
















--
Best regards
Leo Heuser

Followup to newsgroup only please.

"Bob Phillips" skrev i en meddelelse
...
and I had to declare RandNum in it as I always use Option
Explicit.

Me too. How on earth did that declaration disappear <g

Leo Heuser

damn computers <bg

Bob

"Leo Heuser" wrote in message
...
"Bob Phillips" skrev i en meddelelse
...
and I had to declare RandNum in it as I always use Option
Explicit.

Me too. How on earth did that declaration disappear <g

Leo Heuser

The number of iterations seem to depend on the ratio of records
to the range of security numbers allowed.
I chose a ratio of 1 to 10 and the number
of necessary iterations dropped to 4.
Here is my modified formula for 400 records:
=IF(($A$1="")+(AND(B10,COUNTIF($B$1:$B$400,B1)=1) ),B1,
RANDBETWEEN(1000,5000))

"Leo Heuser" wrote
.. Here's ver.2 with more options.
... understatedly ... Superb !!
Many thanks, Leo !
Great flexibility there, runs .. simply marvellous
Thanks for the patient & instructive detailed steps
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

"Max" skrev i en meddelelse
...
"Leo Heuser" wrote
.. Here's ver.2 with more options.
.. understatedly ... Superb !!
Many thanks, Leo !
Great flexibility there, runs .. simply marvellous
Thanks for the patient & instructive detailed steps

You're welcome, Max, and thanks for your positive and
kind feedback!
As you probably have experienced, the "All cells" option
is for small ranges only <g
I will try to speed it up.


Cheers
Leo

Hi Leo,

Thanks for a great solution, just what i was looking for, however, I've hit
a bit of a problem and my VBA skills aren't good enough to determine the
problem.

I copied your code, as per instructions, into a new workbook and it worked a
dream. Confident in my own limited skills I went to my workbook where I
wanted the origianl random numbers and repeated the process. Failure, I can't
get past the following error message:

Runtime error '1004': Method 'Range' of object '_Worksheet' failed.

When I click Debug the following line of code is highlighted:

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)

The "RandTable" is on the local worksheet as you suggest (Sheet10 in my
case), in fact I did no more than when I got it working in a new workbook.

Is there something blindingly obvious I have missed?

Thanks in advance,
Ian.


"Leo Heuser" wrote:

"Max" skrev i en meddelelse
...

Great sub, Leo !

Is there a simple way to bring over to Excel screen via say, an inputbox,
so
that we can define the clickable ranges and the numeric limits below in
Excel
itself ?



Thanks Max!

Here's ver.2 with more options.

The Rand data is now set up in a named table in the proper worksheet(s).
The random numbers are still fetched by doubleclicking a cell, but you now
have a choice of filling one cell or all cells.

The name must be "RandTable" (without quotes) and it must be local, so
in sheet1 the name is sheet1!RandTable, in sheet2 the name is
sheet2!RandTable etc.

For example my named range is H2:L12 (H1:L1 contains headings).

Not all rows in the range need to be filled, but blank rows must not exist
between filled rows. H2:L6 could contain definitions with empty cells in
H7:L12, which is OK.
H2:L6 and H9:L9 containing definitions and H7:L8 being empty is
not allowed.

The table has 5 columns with these headings:
Column 1: Range
Column 2: First number
Column 3: Last number
Column 4: Step
Column 5: All cells

Examples:

B2:B6 2 60 2 yes
G20:K100 5 1000 3

B2:B6 will be filled with even numbers in the range 2 - 60 (inclusive).
Step 2 means, that the random numbers will be 2,4,6,8,10,.....,60.
The "yes" in column 5 means, that doubleclicking a cell in B2:B6 will
fill all cells at once. If the cell in column 5 is empty, a click will only
fill the clicked cell.
The "yes" could have been anything (true, 1 etc). As long as the cell
is *not empty*, all cells in the range will be filled immediately.

The second example has a pool of random numbers consisting of
5,8,11,14,17,.........
Doubleclicking a cell in G20:K100 will only fill this cell.

Doubleclicking a filled cell, will ask you, if you want a new number(s).

There's no limit to the number of RandRanges.

The below sub "Worksheet_BeforeDoubleClick" is inserted by copying
the code, rightclicking the sheet tab and paste to the righthand window.

The same code can be inserted from more sheets at the same time.
The important thing is, that the RandTables are named *locally* as
described above.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
'Leo Heuser, 20 Sep. 2006, ver. 2
Dim Answer As Variant
Dim Cell As Range
Dim Counter As Long
Dim Counter1 As Long
Dim DummyRange As Range
Dim RandData As Variant
Dim RandRange As Range
Dim RandTableRange As Range
Dim RandTableValue As Variant
Dim RandTableName As String

RandTableName = "RandTable"

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)
Set RandTableRange = RandTableRange. _
Resize(Application.CountA(RandTableRange.Columns(1 )))

RandData = RandTableRange.Value

For Counter = LBound(RandData, 1) To UBound(RandData, 1)
Set RandRange = Range(RandData(Counter, 1))

If Not Intersect(Target, RandRange) Is Nothing Then
If Target.Cells.Count 1 Then Exit Sub

Cancel = True

If Not (IsEmpty(Target)) Then
Answer = MsgBox("Do you want a new random number(s)?", _
vbDefaultButton2 + vbYesNo)
If Answer < vbYes Then Exit Sub
End If

If IsEmpty(RandData(Counter, 5)) Then
Set DummyRange = Target
Else
RandRange.ClearContents
Set DummyRange = RandRange
End If

For Each Cell In DummyRange.Cells
Cell.Value = NewRandNum(RandRange, _
RandData(Counter, 2), _
RandData(Counter, 3), _
RandData(Counter, 4))
Next Cell

Exit Sub
End If
Next Counter
End Sub


The code below is inserted in a general module.
(<Alt<F11, Insert Module)


Function NewRandNum(RandRange As Range, FirstNum As Variant, _
LastNum As Variant, StepValue As Variant) As Variant
'Leo Heuser, 20 Sep. 2006, ver. 2
'When a number is inserted in a cell, it's not updated ever,
'and it is removed from the random number pool of that range.
'If a number is deleted from a cell, it's automatically added
'to the pool of that range.
Dim Counter As Double
Dim Counter1 As Long
Dim RandCol As New Collection
Dim RandNum As Long
Dim RandRangeValue As Variant

Randomize

RandRangeValue = RandRange.Value

On Error Resume Next

If LastNum < FirstNum Then
StepValue = -Abs(StepValue)
Else
StepValue = Abs(StepValue)
End If

For Counter = FirstNum To LastNum Step StepValue
RandCol.Add Item:=Counter, key:=CStr(Counter)
Next Counter

For Counter = 1 To UBound(RandRangeValue, 1)
For Counter1 = 1 To UBound(RandRangeValue, 2)
If Not (IsEmpty(RandRangeValue(Counter, Counter1))) Then
RandCol.Add Item:=RandRangeValue(Counter, Counter1), _
key:=CStr(RandRangeValue(Counter, Counter1))
If Err.Number < 0 Then
RandCol.Remove _
CStr(RandRangeValue(Counter, Counter1))
Err.Number = 0
End If
End If
Next Counter1
Next Counter

RandNum = Int(Rnd() * RandCol.Count) + 1

NewRandNum = RandCol(RandNum)

On Error GoTo 0

End Function


Cheers
Leo
















--
Best regards
Leo Heuser

Followup to newsgroup only please.

Leo,

If I change the name of the worksheet back to "Sheet10" then it works, it
seems to be something to do with the sheet being incorrectly named as far as
VBA is concerned. Is there another Activesheet property that will recognise a
sheetname other than "Sheet*"?

Thanks
Ian.

"Ian" wrote:

Hi Leo,

Thanks for a great solution, just what i was looking for, however, I've hit
a bit of a problem and my VBA skills aren't good enough to determine the
problem.

I copied your code, as per instructions, into a new workbook and it worked a
dream. Confident in my own limited skills I went to my workbook where I
wanted the origianl random numbers and repeated the process. Failure, I can't
get past the following error message:

Runtime error '1004': Method 'Range' of object '_Worksheet' failed.

When I click Debug the following line of code is highlighted:

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)

The "RandTable" is on the local worksheet as you suggest (Sheet10 in my
case), in fact I did no more than when I got it working in a new workbook.

Is there something blindingly obvious I have missed?

Thanks in advance,
Ian.


"Leo Heuser" wrote:

"Max" skrev i en meddelelse
...

Great sub, Leo !

Is there a simple way to bring over to Excel screen via say, an inputbox,
so
that we can define the clickable ranges and the numeric limits below in
Excel
itself ?



Thanks Max!

Here's ver.2 with more options.

The Rand data is now set up in a named table in the proper worksheet(s).
The random numbers are still fetched by doubleclicking a cell, but you now
have a choice of filling one cell or all cells.

The name must be "RandTable" (without quotes) and it must be local, so
in sheet1 the name is sheet1!RandTable, in sheet2 the name is
sheet2!RandTable etc.

For example my named range is H2:L12 (H1:L1 contains headings).

Not all rows in the range need to be filled, but blank rows must not exist
between filled rows. H2:L6 could contain definitions with empty cells in
H7:L12, which is OK.
H2:L6 and H9:L9 containing definitions and H7:L8 being empty is
not allowed.

The table has 5 columns with these headings:
Column 1: Range
Column 2: First number
Column 3: Last number
Column 4: Step
Column 5: All cells

Examples:

B2:B6 2 60 2 yes
G20:K100 5 1000 3

B2:B6 will be filled with even numbers in the range 2 - 60 (inclusive).
Step 2 means, that the random numbers will be 2,4,6,8,10,.....,60.
The "yes" in column 5 means, that doubleclicking a cell in B2:B6 will
fill all cells at once. If the cell in column 5 is empty, a click will only
fill the clicked cell.
The "yes" could have been anything (true, 1 etc). As long as the cell
is *not empty*, all cells in the range will be filled immediately.

The second example has a pool of random numbers consisting of
5,8,11,14,17,.........
Doubleclicking a cell in G20:K100 will only fill this cell.

Doubleclicking a filled cell, will ask you, if you want a new number(s).

There's no limit to the number of RandRanges.

The below sub "Worksheet_BeforeDoubleClick" is inserted by copying
the code, rightclicking the sheet tab and paste to the righthand window.

The same code can be inserted from more sheets at the same time.
The important thing is, that the RandTables are named *locally* as
described above.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
'Leo Heuser, 20 Sep. 2006, ver. 2
Dim Answer As Variant
Dim Cell As Range
Dim Counter As Long
Dim Counter1 As Long
Dim DummyRange As Range
Dim RandData As Variant
Dim RandRange As Range
Dim RandTableRange As Range
Dim RandTableValue As Variant
Dim RandTableName As String

RandTableName = "RandTable"

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)
Set RandTableRange = RandTableRange. _
Resize(Application.CountA(RandTableRange.Columns(1 )))

RandData = RandTableRange.Value

For Counter = LBound(RandData, 1) To UBound(RandData, 1)
Set RandRange = Range(RandData(Counter, 1))

If Not Intersect(Target, RandRange) Is Nothing Then
If Target.Cells.Count 1 Then Exit Sub

Cancel = True

If Not (IsEmpty(Target)) Then
Answer = MsgBox("Do you want a new random number(s)?", _
vbDefaultButton2 + vbYesNo)
If Answer < vbYes Then Exit Sub
End If

If IsEmpty(RandData(Counter, 5)) Then
Set DummyRange = Target
Else
RandRange.ClearContents
Set DummyRange = RandRange
End If

For Each Cell In DummyRange.Cells
Cell.Value = NewRandNum(RandRange, _
RandData(Counter, 2), _
RandData(Counter, 3), _
RandData(Counter, 4))
Next Cell

Exit Sub
End If
Next Counter
End Sub


The code below is inserted in a general module.
(<Alt<F11, Insert Module)


Function NewRandNum(RandRange As Range, FirstNum As Variant, _
LastNum As Variant, StepValue As Variant) As Variant
'Leo Heuser, 20 Sep. 2006, ver. 2
'When a number is inserted in a cell, it's not updated ever,
'and it is removed from the random number pool of that range.
'If a number is deleted from a cell, it's automatically added
'to the pool of that range.
Dim Counter As Double
Dim Counter1 As Long
Dim RandCol As New Collection
Dim RandNum As Long
Dim RandRangeValue As Variant

Randomize

RandRangeValue = RandRange.Value

On Error Resume Next

If LastNum < FirstNum Then
StepValue = -Abs(StepValue)
Else
StepValue = Abs(StepValue)
End If

For Counter = FirstNum To LastNum Step StepValue
RandCol.Add Item:=Counter, key:=CStr(Counter)
Next Counter

For Counter = 1 To UBound(RandRangeValue, 1)
For Counter1 = 1 To UBound(RandRangeValue, 2)
If Not (IsEmpty(RandRangeValue(Counter, Counter1))) Then
RandCol.Add Item:=RandRangeValue(Counter, Counter1), _
key:=CStr(RandRangeValue(Counter, Counter1))
If Err.Number < 0 Then
RandCol.Remove _
CStr(RandRangeValue(Counter, Counter1))
Err.Number = 0
End If
End If
Next Counter1
Next Counter

RandNum = Int(Rnd() * RandCol.Count) + 1

NewRandNum = RandCol(RandNum)

On Error GoTo 0

End Function


Cheers
Leo
















--
Best regards
Leo Heuser

Followup to newsgroup only please.

Hi Ian

My fault. You probably have a sheet name with
one or more spaces.
I forgot to include apostrophes in the code.
I have the final (? :-) version ready tomorrow, so please watch
the thread.

Regards
Leo Heuser


"Ian" skrev i en meddelelse
...
Hi Leo,

Thanks for a great solution, just what i was looking for, however, I've
hit
a bit of a problem and my VBA skills aren't good enough to determine the
problem.

I copied your code, as per instructions, into a new workbook and it
worked a
dream. Confident in my own limited skills I went to my workbook where I
wanted the origianl random numbers and repeated the process. Failure, I
can't
get past the following error message:

Runtime error '1004': Method 'Range' of object '_Worksheet' failed.

When I click Debug the following line of code is highlighted:

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)

The "RandTable" is on the local worksheet as you suggest (Sheet10 in my
case), in fact I did no more than when I got it working in a new
workbook.

Is there something blindingly obvious I have missed?

Thanks in advance,
Ian.

"Leo Heuser" wrote:
.. I have the final (? :-) version ready tomorrow,
so please watch the thread.

Just to let on that I'm watching, Leo <g.
Look forward to it ..
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

"Ian" skrev i en meddelelse
...
Hi Leo,

Thanks for a great solution, just what i was looking for, however, I've
hit
a bit of a problem and my VBA skills aren't good enough to determine the
problem.

I copied your code, as per instructions, into a new workbook and it
worked a
dream. Confident in my own limited skills I went to my workbook where I
wanted the origianl random numbers and repeated the process. Failure, I
can't
get past the following error message:

Runtime error '1004': Method 'Range' of object '_Worksheet' failed.

When I click Debug the following line of code is highlighted:

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)

The "RandTable" is on the local worksheet as you suggest (Sheet10 in my
case), in fact I did no more than when I got it working in a new
workbook.

Is there something blindingly obvious I have missed?

Thanks in advance,
Ian.

Hi Ian (and Max :-)

Glad you could use it!

Here's version 3.0 with two more options. You have a choice of having
duplicates in the pool, and the range for the random numbers can concist
of non-contiguous areas. Please notice, that the sub "...BeforeDoubleclick"
is now inserted in "ThisWorkbook".

A.
The Rand data is set up in a named table in the proper worksheet(s).
The headings are *not* part of the name!

For example a named table could be H2:M12 (H1:M1 containing headings).

The name must be "RandTable" (without quotes) and it must be local, so
in sheet1 the name is sheet1!RandTable, in sheet2 the name is
sheet2!RandTable etc. Use Insert Name Define.

If you prefer another standard name for you RandTables, you must
edit the following line in "Workbook_SheetBeforeDoubleClick":

Const RAND_TABLE_NAME As String = "RandTable"

If you have spaces in a sheet name, the sheet name must be enclosed
in apostrophes (single quotes) like: 'Random numbers'!RandTable.

An idea is to use the underline character _ instead of space in
sheet names. The readability is the same, and you will never need to
use apostrophes in sheet names again.

If you doubleclick a sheet tab to rename the sheet, it's not necessary
to use single quotes. Excel does it for you.

B.

"Leo Heuser" wrote:
.. Here's version 3.0 with two more options. You have a choice of having
duplicates in the pool, and the range for the random numbers can consist
of non-contiguous areas ..

Magnificent, Leo! A classic.

Very fast populating of large ranges
(eg: 10k unique rand nos within a 1000R x 10C grid in 5 secs!).

Just some thoughts on this new prompt encountered:
"Too few numbers in the pool"
for example when I tried it with the settings below
(where the range exceeds the no. of unique numbers)

Range: A31:F38 (a 8R x 6C grid)
First no.: 1
Last no.: 45
Stepval: 1
All cells: yes
Duplicates: No

Your previous ver2 would simply random fill the first 7 rows, and half of
the last 8th row in a zig-zag, left to right manner, leaving the last 3 cells
D38:F38 empty. Could this option / feature be somehow retained, as an
alternative perhaps to "Proceed nonetheless" ? To get it running similarly in
ver3, I'd need to re-define the range as say: A31:F37, A38:C38 (albeit with
ver3's discontiguous ranges allowed, I could now define / choose exactly
where the last 3 cells should be populated). Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

"Max" skrev i en meddelelse
...
"Leo Heuser" wrote:
.. Here's version 3.0 with two more options. You have a choice of having
duplicates in the pool, and the range for the random numbers can consist
of non-contiguous areas ..

Magnificent, Leo! A classic.

Very fast populating of large ranges
(eg: 10k unique rand nos within a 1000R x 10C grid in 5 secs!).

Just some thoughts on this new prompt encountered:
"Too few numbers in the pool"
for example when I tried it with the settings below
(where the range exceeds the no. of unique numbers)

Range: A31:F38 (a 8R x 6C grid)
First no.: 1
Last no.: 45
Stepval: 1
All cells: yes
Duplicates: No

Your previous ver2 would simply random fill the first 7 rows, and half of
the last 8th row in a zig-zag, left to right manner, leaving the last 3
cells
D38:F38 empty. Could this option / feature be somehow retained, as an
alternative perhaps to "Proceed nonetheless" ? To get it running similarly
in
ver3, I'd need to re-define the range as say: A31:F37, A38:C38 (albeit
with
ver3's discontiguous ranges allowed, I could now define / choose exactly
where the last 3 cells should be populated). Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

Hi Max

Thanks for the nice words and your interest in the project!

Here is ver. 3.1 with the alternative. I also managed
to catch a couple of bloopers on the way <g.

The "ThisWorkbook" routine ver. 3.0 still holds.

Best regards
Leo




Sub GetRandNum(Target As Range, RandRange As Range, _
RandTableRange As Range, RandTableRow As Long)
'Leo Heuser, 26 Sep. 2006, ver. 3.1
'When a number is inserted in a cell, it's never updated,
'and it is removed from the number pool of that range.
'If a cell is cleared, the cleared number is added to the
'pool of that range.

Dim AllCells As Boolean
Dim Answer As Variant
Dim AnswerText As String
Dim CountAreas As Long
Dim CountCol As Double
Dim Counter As Long
Dim Counter1 As Long
Dim DupliCates As Boolean
Dim FirstNum As Double
Dim LastNum As Double
Dim NumAreas As Long
Dim RandCol As New Collection
Dim RandArray() As Variant
Dim RandNum As Long
Dim RandRangeValue() As Variant
Dim RandTableValue As Variant
Dim StepValue As Double
Dim YesChoice As Variant

Randomize

YesChoice = Array("x", 1, "yes", True) ' Case doesn't matter

NumAreas = RandRange.Areas.Count

ReDim RandRangeValue(1 To NumAreas)

On Error GoTo Finito

RandTableValue = RandTableRange.Value

FirstNum = RandTableValue(RandTableRow, 2)
LastNum = RandTableValue(RandTableRow, 3)

If IsEmpty(RandTableValue(RandTableRow, 4)) Then
StepValue = 1
Else
StepValue = RandTableValue(RandTableRow, 4)
End If

If LastNum < FirstNum Then
StepValue = -Abs(StepValue)
Else
StepValue = Abs(StepValue)
End If

If Not IsError(Application. _
Match(RandTableValue(RandTableRow, 5), YesChoice, 0)) Then
AllCells = True
Else
AllCells = False
End If

If Not IsError(Application. _
Match(RandTableValue(RandTableRow, 6), YesChoice, 0)) Then
DupliCates = True
Else
DupliCates = False
End If

If AllCells Then
If Application.CountA(RandRange) 0 Then
AnswerText = "Do you want a new set of random numbers "
Answer = MsgBox(AnswerText, _
vbDefaultButton2 + vbYesNo)
If Answer < vbYes Then GoTo Finito
End If

If Not DupliCates Then
If (LastNum - FirstNum) / StepValue + 1 < _
RandRange.Cells.Count Then
AnswerText = "Too few numbers to fill the entire range."
AnswerText = AnswerText & vbNewLine & _
"Proceed nonetheless?"
Answer = MsgBox(AnswerText, vbDefaultButton2 + vbYesNo)

If Answer < vbYes Then GoTo Finito
End If
End If

RandRange.ClearContents
Else
If Not DupliCates Then
If (LastNum - FirstNum) / StepValue + 1 = _
Application.CountA(RandRange) Then
MsgBox "All numbers have been used."
GoTo Finito
End If
End If

If Not (IsEmpty(Target)) Then
Answer = MsgBox("Do you want a new random number?", _
vbDefaultButton2 + vbYesNo)
If Answer < vbYes Then GoTo Finito
End If
End If

For Counter = 1 To RandRange.Areas.Count
RandRangeValue(Counter) = RandRange.Areas(Counter).Value
Next Counter

On Error Resume Next

For CountCol = FirstNum To LastNum Step StepValue
RandCol.Add Item:=CountCol, key:=CStr(CountCol)
Next CountCol

If AllCells Then
For CountAreas = 1 To NumAreas
If RandRange.Areas(CountAreas).Cells.Count = 1 Then
RandNum = Int(Rnd() * RandCol.Count) + 1
If RandCol.Count 0 Then
RandRange.Areas(CountAreas).Value = RandCol(RandNum)
If Not (DupliCates) Then RandCol.Remove RandNum
Else
RandRange.Areas(CountAreas).Value = Empty
End If
Else

ReDim RandArray(1 To UBound(RandRangeValue(CountAreas), 1), _
1 To UBound(RandRangeValue(CountAreas), 2))

For Counter = 1 To UBound(RandRangeValue(CountAreas), 1)
For Counter1 = 1 To UBound(RandRangeValue(CountAreas), 2)
RandNum = Int(Rnd() * RandCol.Count) + 1
If RandCol.Count 0 Then
RandArray(Counter, Counter1) = RandCol(RandNum)
If Not (DupliCates) Then RandCol.Remove RandNum
Else
RandArray(Counter, Counter1) = Empty
End If
Next Counter1
Next Counter

RandRange.Areas(CountAreas).Value = RandArray
End If
Next CountAreas
Else
If Not (DupliCates) Then
For CountAreas = 1 To NumAreas
If RandRange.Areas(CountAreas).Cells.Count = 1 Then
If Not (IsEmpty(RandRangeValue(CountAreas))) Then
RandCol.Add Item:= _
RandRangeValue(CountAreas), _
key:=CStr(RandRangeValue(CountAreas))

If Err.Number < 0 Then
RandCol.Remove CStr(RandRangeValue(CountAreas))
Err.Number = 0
End If
End If
Else
For Counter = 1 To UBound(RandRangeValue(CountAreas), 1)
For Counter1 = 1 To UBound(RandRangeValue(CountAreas), 2)
If Not (IsEmpty(RandRangeValue(CountAreas)(Counter, _
Counter1))) Then
RandCol.Add Item:= _
RandRangeValue(CountAreas)(Counter, Counter1), _
key:=CStr(RandRangeValue(CountAreas)(Counter, Counter1))

If Err.Number < 0 Then
RandCol.Remove _
CStr(RandRangeValue(CountAreas)(Counter, Counter1))
Err.Number = 0
End If
End If
Next Counter1
Next Counter
End If
Next CountAreas
End If

On Error GoTo Finito

RandNum = Int(Rnd() * RandCol.Count) + 1
Target.Value = RandCol(RandNum)
End If

Finito:
If Err.Number < 0 Then
MsgBox "Unexpected error." & vbNewLine & Err.Description
End If

On Error GoTo 0

End Sub

Ahh, excellent! Just the way I wanted it served <g
Many thanks, Leo ! cheers
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Leo Heuser" wrote:
Hi Max

Thanks for the nice words and your interest in the project!

Here is ver. 3.1 with the alternative. I also managed
to catch a couple of bloopers on the way <g.

The "ThisWorkbook" routine ver. 3.0 still holds.

Best regards
Leo

Bon appétit, Max <g

Cheers
Leo


"Max" skrev i en meddelelse
...
Ahh, excellent! Just the way I wanted it served <g
Many thanks, Leo ! cheers
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Leo Heuser" wrote:
Hi Max

Thanks for the nice words and your interest in the project!

Here is ver. 3.1 with the alternative. I also managed
to catch a couple of bloopers on the way <g.

The "ThisWorkbook" routine ver. 3.0 still holds.

Best regards
Leo

My compliments to the chef <g
Truly fine cuisine ..
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Leo Heuser" wrote in message
...
Bon appétit, Max <g

Cheers
Leo

Hi Leo,

Many apologies for the delay in replying to the v3 project you posted, I've
just implemented your upgrade and it works great. I've come back to the forum
and notice v3.1 now posted which I will duly upgrade to.

This has proved a very popular thread and has got me thinking of other uses
for this random number generation. I tried to populate a 31 day calender with
a work duty roster using the number of staff (11) in our department and
thought that if I selected "Yes" to duplicates it would fill the range
anyhow. This doesn't seem to be the case as the message is not enough numbers
in the pool. How easy would it be to fill a range with a set of numbers
smaller than the range even if duplicates is selected?

I'd like to thank you for all your code samples in reply to my initial
question, you have truly "stepped up to the plate". If my last suggestion is
seen as being too cheeky, please tell me to clear off and read the books!!

Thanks again Leo for all your hard work,
Ian.

"Leo Heuser" wrote:

"Ian" skrev i en meddelelse
...
Hi Leo,

Thanks for a great solution, just what i was looking for, however, I've
hit
a bit of a problem and my VBA skills aren't good enough to determine the
problem.

I copied your code, as per instructions, into a new workbook and it
worked a
dream. Confident in my own limited skills I went to my workbook where I
wanted the origianl random numbers and repeated the process. Failure, I
can't
get past the following error message:

Runtime error '1004': Method 'Range' of object '_Worksheet' failed.

When I click Debug the following line of code is highlighted:

Set RandTableRange = Range(ActiveSheet.Name & "!" & RandTableName)

The "RandTable" is on the local worksheet as you suggest (Sheet10 in my
case), in fact I did no more than when I got it working in a new
workbook.

Is there something blindingly obvious I have missed?

Thanks in advance,
Ian.

Hi Ian (and Max :-)

Glad you could use it!

Here's version 3.0 with two more options. You have a choice of having
duplicates in the pool, and the range for the random numbers can concist
of non-contiguous areas. Please notice, that the sub "...BeforeDoubleclick"
is now inserted in "ThisWorkbook".

A.
The Rand data is set up in a named table in the proper worksheet(s).
The headings are *not* part of the name!

For example a named table could be H2:M12 (H1:M1 containing headings).

The name must be "RandTable" (without quotes) and it must be local, so
in sheet1 the name is sheet1!RandTable, in sheet2 the name is
sheet2!RandTable etc. Use Insert Name Define.

If you prefer another standard name for you RandTables, you must
edit the following line in "Workbook_SheetBeforeDoubleClick":

Const RAND_TABLE_NAME As String = "RandTable"

If you have spaces in a sheet name, the sheet name must be enclosed
in apostrophes (single quotes) like: 'Random numbers'!RandTable.

An idea is to use the underline character _ instead of space in
sheet names. The readability is the same, and you will never need to
use apostrophes in sheet names again.

If you doubleclick a sheet tab to rename the sheet, it's not necessary
to use single quotes. Excel does it for you.

B.
The random numbers are fetched by doubleclicking a cell in one of the
defined ranges in column 1 (see below). If a cell(s) is cleared, the
number(s) in the cell(s) is returned to the pool.

C.
The RandTable has 6 columns with these headings:
Column 1: Range
Column 2: First number
Column 3: Last number
Column 4: Stepvalue
Column 5: All cells
Column 6: Duplicates

Column 1: References to the various ranges receiving random numbers
from the matching pool.
Entered as "b3:b2000", "c4:F45" , "Block1" etc. without quotes.

Non-contiguous ranges are supported. The references can be
entered with comma or semicolon as delimiter, e.g. "b3:g14;h2:h40" or
"f3,h3,k5,m5" (without quotes) or named ranges. Block1 above could concist
of 2, 3 or more non-contiguous ranges.

Column 2 and 3: Positive and/or negative integers, 0 and decimal numbers.

Column 4: If empty, a stepvalue of 1 (or -1) is assumed, else as column 2
and 3.
The stepvalue is added (or subtracted) to the first number to get the next
number in the random number pool. Then stepvalue is used on the new
number and so on.

Column 5: If a "yes-choice" (see later) is entered, all cells are filled
with one stroke. For all other entries (including an empty cell) a number
is inserted in the active cell (single-cell mode).

Column 6: If a "yes-choice" (see later) is entered, duplicates are allowed
in the pool. For all other entries (including an empty cell) duplicates are
not used.

Don't edit "First number", "Last number" and/or "Stepvalue" in single-cell
mode until you have cleared the range first!!


D.
Examples:

Range First number Last number Stepvalue All cells Duplicates
B2:B6 2 60 2 yes x
G20:K100 5 1000 3
A2,C2,E2 1 7


In the first example the pool of numbers for B2:B6 will be filled with
even numbers in the range 2 - 60 (inclusive).
Stepvalue 2 means, that the numbers will be 2,4,6,8,10,.....,60.
The "yes" in column 5 means, that doubleclicking a cell in B2:B6 will
fill all cells at once. The "x" in column 6 means that duplicates are
allowed in the pool.

The second example has a pool of numbers consisting of
5,8,11,14,17,.........
Doubleclicking a cell in G20:K100 will only fill this cell.

The third example shows a non-contiguous range consisting of 3 cells
with this pool of the numbers 1, 2, 3, 4, 5, 6 og 7.

Doubleclicking a filled cell in single-cell mode will bring up a message
box asking you, if you want a new random number in the cell.

In "AllCells" mode, doubleclicking a cell (filled or not) will ask you,
if you want the entire range to be filled with new random numbers.

There's no limit to the number of RandTables and they can reside
in one or more sheets, but each table only works for ranges in the
same sheet. The important thing is, that it's given a local name as
described above.

E:
The below sub "Workbook_SheetBeforeDoubleClick" is inserted by
copying the code, going to the VBA-editor with <Alt<F11, double-
clicking "ThisWorkbook" for the project in the project window (at the
left of the screen. If not visible press <Ctrlr) and paste to the righthand
window.


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
'Leo Heuser, 23 Sep. 2006, ver. 3.0

Const RAND_TABLE_NAME As String = "RandTable"

Dim Counter As Long
Dim RandData As Variant
Dim RandRange As Range
Dim RandTableRow As Long
Dim RandTableRange As Range

On Error Resume Next

Set RandTableRange = Range("'" & ActiveSheet.Name & "'!" & _
RAND_TABLE_NAME)

If Err.Number < 0 Then
Err.Number = 0
GoTo Finito
End If

On Error GoTo Finito

RandData = RandTableRange.Value

For Counter = LBound(RandData, 1) To UBound(RandData, 1)
If Not IsEmpty(RandData(Counter, 1)) Then
Set RandRange = _
Range(Replace(RandData(Counter, 1), ";", ","))
If Not Intersect(Target, RandRange) Is Nothing Then
If Target.Cells.Count 1 Then GoTo Finito

RandTableRow = Counter
Cancel = True

On Error GoTo 0

Call GetRandNum(Target, RandRange, _
RandTableRange, RandTableRow)

Exit For
End If
End If
Next Counter

Finito:
If Err.Number < 0 Then
MsgBox "Unexpected error." & vbNewLine & Err.Description
End If

On Error GoTo 0

End Sub



F:
The sub "GetRandNum" is inserted in a standard module.
Copy the code below. In the VBA editor choose Insert Module,
and paste into the righthand window.

In the line

YesChoice = Array("x", 1, "yes", True) ' Case doesn't matter

you can add your own "Yes"-choices.

"True" means, that the user can enter the local equivalent to
TRUE in the RandTable, if you work in a localised version of Excel.
In Danish it is SAND, in German WAHR, in French VRAI etc.


Sub GetRandNum(Target As Range, RandRange As Range, _
RandTableRange As Range, RandTableRow As Long)
'Leo Heuser, 23 Sep. 2006, ver. 3.0
'When a number is inserted in a cell, it's never updated,
'and it is removed from the number pool of that range.
'If a number is deleted from a cell, it's automatically added
'to the pool of that range.

Dim AllCells As Boolean
Dim Answer As Variant
Dim AnswerText As String
Dim CountAreas As Long
Dim CountCol As Double
Dim Counter As Long
Dim Counter1 As Long
Dim DupliCates As Boolean
Dim FirstNum As Double
Dim LastNum As Double
Dim NumAreas As Long
Dim RandCol As New Collection
Dim RandArray() As Double
Dim RandNum As Long
Dim RandRangeValue() As Variant
Dim RandTableValue As Variant
Dim StepValue As Double
Dim YesChoice As Variant

Randomize

YesChoice = Array("x", 1, "yes", True) ' Case doesn't matter

NumAreas = RandRange.Areas.Count

ReDim RandRangeValue(1 To NumAreas)

On Error GoTo Finito

RandTableValue = RandTableRange.Value

FirstNum = RandTableValue(RandTableRow, 2)
LastNum = RandTableValue(RandTableRow, 3)

If IsEmpty(RandTableValue(RandTableRow, 4)) Then
StepValue = 1
Else
StepValue = RandTableValue(RandTableRow, 4)
End If

If LastNum < FirstNum Then
StepValue = -Abs(StepValue)
Else
StepValue = Abs(StepValue)
End If

If (LastNum - FirstNum) / StepValue + 1 < _
RandRange.Cells.Count Then
MsgBox "Too few numbers in the pool."
GoTo Finito
End If

If Not IsError(Application. _
Match(RandTableValue(RandTableRow, 5), YesChoice, 0)) Then
AllCells = True
Else
AllCells = False
End If

If Not IsError(Application. _
Match(RandTableValue(RandTableRow, 6), YesChoice, 0)) Then
DupliCates = True
Else
DupliCates = False
End If

If AllCells Then
If Application.CountA(RandRange) 0 Then
AnswerText = "Do you want new random numbers "

Hi Ian


"Ian" skrev i en meddelelse
...
Hi Leo,

Many apologies for the delay in replying to the v3 project you posted,
I've
just implemented your upgrade and it works great. I've come back to the
forum
and notice v3.1 now posted which I will duly upgrade to.

This has proved a very popular thread and has got me thinking of other
uses
for this random number generation. I tried to populate a 31 day calender
with
a work duty roster using the number of staff (11) in our department and
thought that if I selected "Yes" to duplicates it would fill the range
anyhow. This doesn't seem to be the case as the message is not enough
numbers
in the pool. How easy would it be to fill a range with a set of numbers
smaller than the range even if duplicates is selected?


Max beat you to it <g . It has been implemented in v3.1.



I'd like to thank you for all your code samples in reply to my initial
question, you have truly "stepped up to the plate". If my last suggestion
is
seen as being too cheeky, please tell me to clear off and read the books!!

Thanks again Leo for all your hard work,
Ian.

You are welcome, Ian, and thanks for your positive feedback!


Regards
Leo Heuser

Doh!! Didn't look close enough at v3.1. Just run it and yep it's just what I
was asking for, ta again.

Ian.

"Leo Heuser" wrote:

Hi Ian


"Ian" skrev i en meddelelse
...
Hi Leo,

Many apologies for the delay in replying to the v3 project you posted,
I've
just implemented your upgrade and it works great. I've come back to the
forum
and notice v3.1 now posted which I will duly upgrade to.

This has proved a very popular thread and has got me thinking of other
uses
for this random number generation. I tried to populate a 31 day calender
with
a work duty roster using the number of staff (11) in our department and
thought that if I selected "Yes" to duplicates it would fill the range
anyhow. This doesn't seem to be the case as the message is not enough
numbers
in the pool. How easy would it be to fill a range with a set of numbers
smaller than the range even if duplicates is selected?


Max beat you to it <g . It has been implemented in v3.1.



I'd like to thank you for all your code samples in reply to my initial
question, you have truly "stepped up to the plate". If my last suggestion
is
seen as being too cheeky, please tell me to clear off and read the books!!

Thanks again Leo for all your hard work,
Ian.

You are welcome, Ian, and thanks for your positive feedback!


Regards
Leo Heuser