12/04/2014

Generate a Unique Random id on a range of cells - Simple Random Sample

Generate a Unique Random id on a range of cells

Hi this is my method to assign a unique random number whithin the desired range of values to each of the cells in the selected Range.

The uniqueRandomLongMethods has been copied from http://www.cpearson.com/excel/randomnumbers.aspx



 Public Sub attributeRandomRange()  
 Dim myArray As Variant  
 Dim i As Integer  
 Dim requiredRange As Range   
 Set requiredRange = Selection  
   myArray = UniqueRandomLongs(1, requiredRange.Count, requiredRange.Count)  
   i = 1  
   For Each Cell In requiredRange.Cells  
      Cell.Value = myArray(i)  
      i = i + 1  
   Next   
 End Sub  
 Public Function UniqueRandomLongs(Minimum As Long, Maximum As Long, _  
       Number As Long, Optional ArrayBase As Long = 1, _  
       Optional Dummy As Variant) As Variant  
 Dim SourceArr() As Long  
 Dim ResultArr() As Long  
 Dim SourceNdx As Long  
 Dim ResultNdx As Long  
 Dim TopNdx As Long  
 Dim Temp As Long  
 If Minimum > Maximum Then  
   UniqueRandomLongs = Null  
   Exit Function  
 End If  
 If Number > (Maximum - Minimum + 1) Then  
   UniqueRandomLongs = Null  
   Exit Function  
 End If  
 If Number <= 0 Then  
   UniqueRandomLongs = Null  
   Exit Function  
 End If  
 Randomize  
 ''''''''''''''''''''''''''''''''''''''''''''''  
 ReDim SourceArr(Minimum To Maximum)  
 ReDim ResultArr(ArrayBase To (ArrayBase + Number - 1))  
 For SourceNdx = Minimum To Maximum  
   SourceArr(SourceNdx) = SourceNdx  
 Next SourceNdx  
 TopNdx = UBound(SourceArr)  
 For ResultNdx = LBound(ResultArr) To UBound(ResultArr)  
   SourceNdx = Int((TopNdx - Minimum + 1) * Rnd + Minimum)  
   ResultArr(ResultNdx) = SourceArr(SourceNdx)  
   Temp = SourceArr(SourceNdx)  
   SourceArr(SourceNdx) = SourceArr(TopNdx)  
   SourceArr(TopNdx) = Temp  
   TopNdx = TopNdx - 1  
 Next ResultNdx  
 UniqueRandomLongs = ResultArr  
 End Function  

Here I ran the code 3 times. First for A1:A17, then for B1:B17 then C1:C17.

Cheers


2 comments:

  1. your code has a error.it drops 1 random number,it works OK if you enter the values into function ie
    (1,90,90) min,max,number

    ReplyDelete