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