Getting Random Numbers In VBA
This page has been replaced with a new, updated version. If you are not automatically redirected, click here.
VBA has a function named Rnd that returns a random number
between 0 and 1 (0 <= Rnd < 1). If you are using the
Analysis Tool Pak VBA add-in, you can call the RandBetween function,
which return a integer between a specified minimum and maximum. But there is
no built in way to get an array of random integers, or, more importantly, an
array of random integers with no duplicated values.
This page describes two functions, RandomLongs and UniqueRandomLongs, which return arrays containing a specified number of elements between a specified minimum value and maximum value. For example, you can get an array containing 100 elements, each of which is between 1000 and 5000. The difference between the two functions is that the array returned by RandomLongs may contain duplicate elements, while the array returned by UniqueRandomLongs will not contain any duplicate values. You may specify the Lower Bound of the result array with the ArrayBase parameter. If ArrayBase is omitted, it defaults to 1. Both functions may be called either from another VBA procedure or from a range of worksheet cells, using an array formula. The code allocates an array for internal use that contains (Maximum-Minimum+1) elements. If you specify a very large range between Minimum and Maximum, you may encounter performance problems. You can download a bas code module containing the functions here or a full workbook with demonstration procedures here. Public Function RandomLongs(Minimum As Long, Maximum As Long, _ Number As Long, Optional ArrayBase As Long = 1, _ Optional Dummy As Variant) As Variant This procedure returns an array of Longs between Minimum and Maximum (inclusive). The lower bound of the array is specified by the ArrayBase parameter. If ArrayBase is omitted, the lower bound is set to 1. The result array will contain Number elements, all between Minimum and Maximum (inclusive). The Number parameter must be greater than 0. It is possible that there will be duplicates within the array. If an invalid parameter is passed to the function (e.g., Minimum > Maximum), the function returns NULL. The Dummy argument is used only when the function is called from a worksheet. See the Using The Functions On A Worksheet section for details. Public Function RandomLongs(Minimum As Long, Maximum As Long, _ Number As Long, Optional ArrayBase As Long = 1, _ Optional Dummy As Variant) As Variant ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' RandomLongs ' This returns an array containing elements whose values are between the Minimum and ' Maximum parameters. The number of elements in the result array is specified by the ' Number parameter. For example, you can request an array of 20 Longs between 500 and ' 1000 (inclusive). ' ' The ArrayBase parameter is used to specify the LBound of the ResultArray. If this ' is omitted, ResultArray is 1-based. ' ' It is possible that there will be duplicate values in the result array. If you need ' non-duplicated values, use UniqueRandomLongs. ' ' The Dummy argument is to be used only when the function is called from a worksheet. ' Its purpose is to allow you to use the NOW() function as the Dummy parameter to force ' Excel to calculate this function any time a calculation is performed. E.g., ' =RandomLongs(100,199,10,NOW()) ' If you don't want to recalulate this function on every calculation, omit the Dummy ' parameter. The Dummy argument serves no other purpose and is not used anywhere ' in the code. ' ' The function returns an array of Longs if successful or NULL if an error occurred ' (invalid input parameter). ' ' Note: The procedure creates its own array of size (Maximum-Minium+1), so very large ' differences between Minimum and Maximum may cause performace issues. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim SourceArr() As Long Dim ResultArr() As Long Dim SourceNdx As Long Dim ResultNdx As Long ''''''''''''''''''''''''''''''''''''' ' Ensure the parameters are valid. ''''''''''''''''''''''''''''''''''''' If Minimum > Maximum Then RandomLongs = Null Exit Function End If If Number > (Maximum - Minimum + 1) Then RandomLongs = Null Exit Function End If If Number <= 0 Then RandomLongs = Null Exit Function End If '''''''''''''''''''''''''''''''''''''''''' ' Redim The Arrays. ' SourceArray will contain all the numbers ' between Minimum and Maximum thus having ' (Maximum-Minimum+1) elements. The LBound ' of SourceArray is Minimum and the UBound ' of SourceArray is Maximum. ' ResultArray will have Number elements. ' The LBound of ResultArray is ArrayBase ' and the UBound of ResultArray is ' (Base+Number-1). '''''''''''''''''''''''''''''''''''''''''' ReDim SourceArr(Minimum To Maximum) For SourceNdx = Minimum To Maximum SourceArr(SourceNdx) = SourceNdx Next SourceNdx ReDim ResultArr(ArrayBase To (ArrayBase + Number - 1)) ''''''''''''''''''''''''''' ' Reset the random number ' generator. ''''''''''''''''''''''''''' Randomize For ResultNdx = LBound(ResultArr) To UBound(ResultArr) ''''''''''''''''''''''''''''''''''''''''''''''''' ' Set the SourceIndex to a random number between ' Minimum and Maximum, which are the lower and ' upper bounds of SourceArr. ''''''''''''''''''''''''''''''''''''''''''''''''' SourceNdx = Int((Maximum - Minimum + 1) * Rnd + Minimum) ''''''''''''''''''''''''''''''''''''''''''''''''' ' Take the value of SourceArr(SourceNdx) and put ' it in the ResultArr array. ''''''''''''''''''''''''''''''''''''''''''''''''' ResultArr(ResultNdx) = SourceArr(SourceNdx) Next ResultNdx '''''''''''''''''''''''''''''''' ' Return ResultArr as the result '''''''''''''''''''''''''''''''' RandomLongs = ResultArr End Function Public Function UniqueRandomLongs(Minimum As Long, Maximum As Long, _ Number As Long, Optional ArrayBase As Long = 1, _ Optional Dummy As Variant) As Variant This procedure returns an array of Longs between Minimum and Maximum (inclusive). The lower bound of the array is specified by the ArrayBase parameter. If ArrayBase is omitted, the lower bound is set to 1. The result array will contains Number elements, all between Minimum and Maximum (inclusive). The Number parameter must be greater than 0. There will be no duplicate entries in the result array. If an error occurs (e.g., Minimum > Maximum), the function returns NULL. The Dummy argument is used only when the function is called from a worksheet. See the Using The Functions On A Worksheet section for details. Public Function UniqueRandomLongs(Minimum As Long, Maximum As Long, _ Number As Long, Optional ArrayBase As Long = 1, _ Optional Dummy As Variant) As Variant ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' UniqueRandomLongs ' This returns an array containing elements whose values are between the Minimum and ' Maximum parameters. The number of elements in the result array is specified by the ' Number parameter. For example, you can request an array of 20 Longs between 500 and ' 1000 (inclusive). ' There will be no duplicate values in the result array. ' ' The ArrayBase parameter is used to specify the LBound of the ResultArray. If this ' is omitted, ResultArray is 1-based. ' ' The Dummy argument is to be used only when the function is called from a worksheet. ' Its purpose is to allow you to use the NOW() function as the Dummy parameter to force ' Excel to calculate this function any time a calculation is performed. E.g., ' =UniqueRandomLongs(100,199,10,NOW()) ' If you don't want to recalulate this function on every calculation, omit the Dummy ' parameter. The Dummy argument serves no other purpose and is not used anywhere ' in the code. ' ' The function returns an array of Longs if successful or NULL if an error occurred ' (invalid input parameter). ' ' Note: The procedure creates its own array of size (Maximum-Minium+1), so very large ' differences between Minimum and Maximum may cause performace issues. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim SourceArr() As Long Dim ResultArr() As Long Dim SourceNdx As Long Dim ResultNdx As Long Dim TopNdx As Long Dim Temp As Long '''''''''''''''''''''''''''''''''''''' ' Test the input parameters to ensure ' they are valid. '''''''''''''''''''''''''''''''''''''' 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 the arrays. ' SourceArr will be sized with an LBound of ' Minimum and a UBound of Maximum, and will ' contain the integers between Minimum and ' Maximum (inclusive). ResultArray gets ' a LBound of ArrayBase and a UBound of ' (ArrayBase+Number-1) '''''''''''''''''''''''''''''''''''''''''''''' ReDim SourceArr(Minimum To Maximum) ReDim ResultArr(ArrayBase To (ArrayBase + Number - 1)) '''''''''''''''''''''''''''''''''''''''''''' ' Load SourceArr with the integers between ' Minimum and Maximum (inclusive). '''''''''''''''''''''''''''''''''''''''''''' For SourceNdx = Minimum To Maximum SourceArr(SourceNdx) = SourceNdx Next SourceNdx '''''''''''''''''''''''''''''''''''''''''''''' ' TopNdx is the upper limit of the SourceArr ' from which the Longs will be selected. It ' is initialized to UBound(SourceArr), and ' decremented in each iteration of the loop. ' Selections from SourceArr are always in the ' region including and to the left of TopNdx. ' The region above (to the right of) TopNdx ' is where the used numbers are stored and ' no selection is made from that region of ' the array. '''''''''''''''''''''''''''''''''''''''''''''' TopNdx = UBound(SourceArr) For ResultNdx = LBound(ResultArr) To UBound(ResultArr) '''''''''''''''''''''''''''''''''''''''''''''''''' ' Set SourceNdx to a random number between 1 and ' TopNdx. ResultArr(ResultNdx) will get its value from ' SourceArr(SourceNdx). Only elements of SourceArr ' in the region of the array below (to the left of) ' TopNdx (inclusive) will be selected for inclusion ' in ResultArr. This ensures that the elements in ' ResultArr are not duplicated. '''''''''''''''''''''''''''''''''''''''''''''''''' SourceNdx = Int((TopNdx - Minimum + 1) * Rnd + Minimum) ResultArr(ResultNdx) = SourceArr(SourceNdx) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Now, swap elements SourceNdx and TopNdx of SourceArr, ' moving the value in SourceArr(SourceNdx) to the region ' of SourceArr that is above TopNdx. Since only elements ' of SourceArr in the region below TopNdx (inclusive) are ' possible candidates for inclusion in ResultArr, used ' values are placed at TopNdx to ensure no duplicates. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Temp = SourceArr(SourceNdx) SourceArr(SourceNdx) = SourceArr(TopNdx) SourceArr(TopNdx) = Temp ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Decrment TopNdx. This moves the effective UBound of SourceArr ' downwards (to the left), thus removing used numbers from the ' possibility of inclusion in ResultArr. This ensures we have ' no duplicates in the ResultArr. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' TopNdx = TopNdx - 1 Next ResultNdx '''''''''''''''''''''''''''''' ' Return the result array. '''''''''''''''''''''''''''''' UniqueRandomLongs = ResultArr End Function
Example Usage The following code demonstrates using UniqueRandomLongs. The usage of RandomLongs is identical other than the called function name. Sub DemoUniqueRandomLongs() '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' DemoUniqueRandomLongs ' This demonstrates the UniqueRandomLongs function. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Res As Variant Dim Min As Long Dim Max As Long Dim N As Long ''''''''''''''''''''''''''''' ' Get 20 non-duplicated Longs ' each of which is between ' 101 and 200. ''''''''''''''''''''''''''''' Min = 101 Max = 200 N = 20 Res = UniqueRandomLongs(Minimum:=Min, Maximum:=Max, Number:=N) If IsNull(Res) Then Debug.Print "Error from UniqueRandomLongs." Else For N = LBound(Res) To UBound(Res) Debug.Print Res(N) Next N End If End Sub Using The Functions On A Worksheet Both functions can be called from worksheet cells as array formulas. If you want the results of the function displayed down a column spanning several rows, you must Transpose the result array. Select the range of cells to which the results should be returned, type =TRANSPOSE(UniqueRandomLongs(Minimum,Maximum,Number)) and press CTRL+SHIFT+ENTER rather than just ENTER. Here, Number should be the number of rows into which the formula was entered. That is, if you enter it in cells A1:A10, Number should be 10. If you do this properly, Excel will display the formula in the formula bar enclosed in curly braces { }. If you want the results in a single row, spanning several columns, enter the following formula in the cells to which the results should be returned. Type the formula =UniqueRandomLongs(Minimum,Maximum,Number) and press CTRL+SHIFT+ENTER rather than just ENTER. Here, Number should be the number of columns into which the formula was entered. If you do this properly, Excel will display the formula in the formula bar enclosed in curly braces { }. You can control when Excel recalculates the arrays
returned by the RandomLongs and UniqueRandomLongs functions. If you include
NOW() as the last parameter to the function, Excel will recalculate the
arrays any time any calculation is made. You can reduce the calculation load
by omitting the final argument. The final argument is used only to control
calculation. Its value is not used in the function. To prevent Excel from calculating the array each time any calculation is done, omit the final argument. The NOW() function serves no purpose other than to force a recalculation. Its value is completely ignored by the functions. |
||