Non updatable Unique Random Number

I

Ian

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.
 
B

Bob Phillips

Here is one technique

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 B1
=IF(($A$1="")+(AND(B1>0,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)
 
L

Leo Heuser

Ian said:
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 :)
 
H

Herbert Seidenberg

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.
 
B

Bob Phillips

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)
 
M

Max

Leo Heuser said:
.. 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
 
B

Bob Phillips

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)
 
M

Max

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.
 
B

bplumhoff

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(VBUniqRandInt(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
 
B

Bob Phillips

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)
 
I

Ian

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.
 
L

Leo Heuser

Max said:
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
 
H

Herbert Seidenberg

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(B1>0,COUNTIF($B$1:$B$400,B1)=1)),B1,
RANDBETWEEN(1000,5000))
 
M

Max

.. 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
 
L

Leo Heuser

Max said:
.. 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
 
I

Ian

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.
 
I

Ian

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.
 

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