The following type of question comes up on the online forums very frequently:

Using VBA I would like to have an array holding random numbers between 1 and 10 without duplicates.

The words to pick up on are ‘without duplicates’: the *numbers* are not random, but their *order* is. The most efficient way to do this is to put the numbers 1 to 10 into an array and *shuffle* them into a random order. I don’t need to do this very often in my line of work but, for those occasions when I do, I have this Fisher-Yates shuffle routine sitting in my code library ready for action.

Sub Shuffle(ByRef lngarrNumbers() As Long) Dim lngTemp As Long 'temporary holder for the element being swapped out Dim lngRandom As Long 'random position within the array Dim lngCounter As Long 'simple counter Dim lngUpper As Long 'the upper bound of the array Dim lngLower As Long 'the lower bound of the array lngLower = LBound(lngarrNumbers) lngUpper = UBound(lngarrNumbers) 'initialise VBA's random number generator Randomize For lngCounter = lngUpper To (lngLower + 1) Step -1 'generate random number between lngLower and lngCounter inclusive lngRandom = CLng(Int((lngCounter - lngLower + 1) * Rnd + lngLower)) 'temporarily save the element being swapped out lngTemp = lngarrNumbers(lngCounter) 'randomly swap another element in lngarrNumbers(lngCounter) = lngarrNumbers(lngRandom) 'put the swapped out number back in where the 'other number came from lngarrNumbers(lngRandom) = lngTemp Next lngCounter End Sub

The array is passed *ByRef*, so its randomised order is passed directly back to the caller procedure. Here’s an example which shows how to use the Shuffle procedure:

Sub Example() Const strDELIMITER As String = "," Dim lngarrNumbers() As Long Dim lngCounter As Long ReDim lngarrNumbers(0 To 9) 'populate the array with the numbers '1 to 10, in numerical sequence Debug.Print "Before: "; For lngCounter = LBound(lngarrNumbers) To UBound(lngarrNumbers) lngarrNumbers(lngCounter) = lngCounter + 1 Debug.Print lngarrNumbers(lngCounter) & _ IIf(lngCounter < UBound(lngarrNumbers), strDELIMITER, vbNewLine); Next lngCounter 'shuffle the array Shuffle lngarrNumbers Debug.Print "After: "; 'let's observe the random order of the numbers For lngCounter = LBound(lngarrNumbers) To UBound(lngarrNumbers) Debug.Print lngarrNumbers(lngCounter) & _ IIf(lngCounter < UBound(lngarrNumbers), strDELIMITER, vbNewLine); Next lngCounter End Sub Sub Shuffle(ByRef lngarrNumbers() As Long) Dim lngTemp As Long 'temporary holder for the element being swapped out Dim lngRandom As Long 'random position within the array Dim lngCounter As Long 'simple counter Dim lngUpper As Long 'the upper bound of the array Dim lngLower As Long 'the lower bound of the array lngLower = LBound(lngarrNumbers) lngUpper = UBound(lngarrNumbers) 'initialise VBA's random number generator Randomize For lngCounter = lngUpper To (lngLower + 1) Step -1 'generate random number between lngLower and lngCounter inclusive lngRandom = CLng(Int((lngCounter - lngLower + 1) * Rnd + lngLower)) 'temporarily save the element being swapped out lngTemp = lngarrNumbers(lngCounter) 'randomly swap another element in lngarrNumbers(lngCounter) = lngarrNumbers(lngRandom) 'put the swapped out number back in where the 'other number came from lngarrNumbers(lngRandom) = lngTemp Next lngCounter End Sub

Advertisements

How can I make the Shuffle sub into an excel function?

LikeLike

Hi Daniel,

There are a couple of points we need to take into account if we want to create a VBA UDF which shuffles numbers. Firstly, all numbers on Excel worksheets are Double types – not Long types – so we’ll need to update the shuffle sub to accept a 1-D array of doubles. Like so:

Now we can build up a VBA UDF wrapper function called SHUFFLENUMBERS() which utilises our Shuffle sub. We have to consider the dimensions of the range which will be passed into our UDF:

If a single cell is passed in then we don’t need to shuffle. If a range of multiple cells is passed in then it will be a 2 dimensional array of numbers. This causes a problem because the Shuffle() sub takes a 1 dimensional double array which is passed ByRef. We could amend Shuffle() so that it takes a 2 dimensional array but I’ll try something different: I’ll put the numbers from the range into a 1 dimensional array, shuffle that and then put those shuffled numbers back into a 2 dimensional array to be returned to the worksheet. Here’s my first crack on it:

So, to summarise –

* SHUFFLENUMBERS() is a VBA UDF which is to be used in formulas from the worksheet. It returns an array so select a range of the correct size, type in the formula and press CTRL+SHIFT+ENTER.

* I’ve made SHUFFLENUMBERS() volatile so it recalculates on every calculation event. Remove Application.Volatile to turn this off.

* The Shuffle() sub also needs to be in the project but can only be called from other VBA code and not from the worksheet.

* If an empty cell is passed into the UDF then the empty value will be internally converted to 0.

* If the array range (containing the formula) is larger than rngNumbers then excess cells will hold #N/A values.

* If rngNumbers holds a value which cannot be converted to a number, or if a runtime error occurs, then the formula will return #NUM!.

LikeLike

Thank you very much.

LikeLike