Random number generator question

[mg_reich]

I am trying to create a random 3 digit number. That number gets concatinated with a two digit number (ex. 01, 02, 04). These are two seperate columns.

My formula looks like this (it would be in column C):
=B2&ROUND((RANDBETWEEN(111,999)),0)

This produces something like 01845.

I have a large list of people and I am trying to give them random ID numbers but still be able to organize them a bit (01,02, etc.)

Two questions:
Is there a way to assure that no two numbers will be the same?

Is there a way to add a row without changing the rest of the random numbers? I tried to copy the list of ID numbers and paste them as values and sort them to see if there were any repeats, but this actually gave me different numbers and didn't sort them.

Thanks in advance.

 

[Nogslaw]

You can use a macro to produce your numbers and check to see that they are not duplicates, but it is a process that could possibly result in a never-ending loop. How many people are you talking about?

 

[mg_reich]

Probaby talking about a few hundred. I don't think I have the knowledge to create a macro to do this.

 

[Nogslaw]

This should get you started in the right direction. Sorry, I had to throw it together very quickly.

Private Sub Worksheet_Change(ByVal Target As Range)
'Only do if cells B2:B10000 get changed
If Intersect(Sheets("sheet1").Range("B2:B10000"), Range(Target(1).Address)) Is Nothing Then
Exit Sub
End If

x = 0
Do
'select random number
randomnumber = WorksheetFunction.Round((Rnd * 900) + 100, 0)
'Put random number in column C of same row
Sheets("Sheet1").Range(Target(1).Address).Offset(0, 1).Value = randomnumber
'If it is not a duplicate, then quit
    If WorksheetFunction.CountIf(Sheets("Sheet1").Range("C2:C10000"), randomnumber) < 2 Then
    Exit Sub
    End If
'If it tries more than 1000 times then quit
x = x + 1
If x > 1000 Then
Exit Sub
End If
'try again
Loop
End Sub

 

[erik.van.geit]

Hello!

For this kinda "random-pickers" different technical approaches are possible.
mg_reich, since you don't know much of VBA, I'll give you one which is rather "visible", when stepping through the code with function key F8 you can follow the process on the sheet.
Never use methods which continue to pick items form the entire list. Always reduce the list, deleting the item which was picked.

Option Explicit

Sub pick_numbers()
'Erik Van Geit
'120516 pick numbers from list
'"visual method"
'use array methods instead for short runtime

Dim I As Long
Dim DR As Long  'row to delete

Const FN = 111  'first number
Const LN = 999  'last number
Const NR = 100  '# of items to pick

    If FN > LN Or NR > LN - FN + 1 Then
    MsgBox "Lowest Number < Highest Number" & Chr(10) & "# items < Highest Number - Lowest Number +1", 48, "ERROR"
    Exit Sub
    End If

Application.ScreenUpdating = False

Columns("A:B").ClearContents
    With Range("A1:A" & LN - FN + 1)
    .Formula = "=ROW()+" & FN - 1
    .Value = .Value
    End With

For I = 1 To NR
Randomize Timer
DR = Int((LN - FN + 1 - I + 1) * Rnd) + 1
    With Range("A" & DR)
    Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = .Value
    .Delete Shift:=xlUp
    End With
Next I

Application.ScreenUpdating = False

End Sub

kind regards,
Erik

 

[Legacy 54864]

Here's a way that makes use of Excel's in-built functions and does not involve looping :-

Sub pick_numbers()
Application.ScreenUpdating = False
[C:IV].ClearContents
[D2] = 111
[D2].DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=999
[C2:C890] = "=RAND()"
[C:D].Sort Key1:=[C2], Order1:=xlAscending, Header:=xlNo
[C:C].Delete
Range([A65536].End(xlUp)(2), [A890]).EntireRow.Delete
Range([D2], [A65536].End(xlUp)(1, 4)) = "=B2&C2"
[D:D] = [D:D].Value
[C:C].Delete
Application.ScreenUpdating = True
End Sub

It has been assumed that row 1 is a header row, the names are in col A, and the two digit numbers are in col B

 

[NateO]

Hello,

Assuming 01, 02, 03 etc... Are all unique then it's impossible to concatenate on these and not generate a unique number...

If that's the case, I take the following UDF:<font face=Courier New><SPAN style="color:#00007F">Public</SPAN><SPAN style="color:#00007F">Function</SPAN> rndStr(<SPAN style="color:#00007F">ByRef</SPAN> StrLength<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>)<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN><SPAN style="color:#00007F">Dim</SPAN> b()<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Byte</SPAN>, keyArr()<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Byte</SPAN><SPAN style="color:#00007F">Dim</SPAN> i<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN><SPAN style="color:#00007F">Let</SPAN> keyArr = "0123456789"<SPAN style="color:#00007F">ReDim</SPAN> b(1<SPAN style="color:#00007F">To</SPAN> StrLength * 2)<SPAN style="color:#00007F">For</SPAN> i = 1<SPAN style="color:#00007F">To</SPAN> StrLength * 2<SPAN style="color:#00007F">Step</SPAN> 2
    <SPAN style="color:#00007F">Let</SPAN> b(i) = keyArr(Int(((UBound(keyArr) + 1) \ 2) * Rnd + 1) * 2 - 2)<SPAN style="color:#00007F">Next</SPAN><SPAN style="color:#00007F">Let</SPAN> rndStr = b<SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Function</SPAN></FONT>

And I use it in a worksheet as such:

Book3
	B	C	D	E
1	01	01755
2	02	02237
3	03	03078
4	04	04704
5	05	05873
Sheet1

And, you could test for Dups using techniques described here:

http://www.cpearson.com/excel/duplicat.htm