Putting Numbers In A Random Order In VBA

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
About these ads

About Colin Legg

RAD Developer Microsoft MVP - Excel 2009 - 2013
This entry was posted in Microsoft Excel, Microsoft Office and tagged , , , , , , , . Bookmark the permalink.

3 Responses to Putting Numbers In A Random Order In VBA

  1. Daniel Audet says:

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

    Like this

    • Colin Legg says:

      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:

      Sub Shuffle(ByRef dblarrNumbers() As Double)
      
          Dim dblTemp As Double           '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(dblarrNumbers)
          lngUpper = UBound(dblarrNumbers)
          
          '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
              dblTemp = dblarrNumbers(lngCounter)
              
              'randomly swap another element in
              dblarrNumbers(lngCounter) = dblarrNumbers(lngRandom)
              
              'put the swapped out number back in where the
              'other number came from
              dblarrNumbers(lngRandom) = dblTemp
          
          Next lngCounter
      
      End Sub
      

      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:

      Public Function SHUFFLENUMBERS(ByRef rngNumbers As Range) As Variant
         
          Dim dblarrInput() As Double 'all numbers in worksheets are doubles
          Dim dblarrOutPut() As Double
          Dim rngCell As Range
          Dim lngRows As Long
          Dim lngCols As Long
          Dim i As Long
          Dim j As Long
          Dim k As Long
          Dim l As Long
          
          'optional - force it to recalculate on every calculation event
          Application.Volatile
          
          On Error GoTo ErrorHandler
             
          'what size array do we want to return?
          'we will base this on the size of rngNumbers
          'if you are using XL 2003 or earlier then use .Count
          'instead of .CountLarge
          lngRows = rngNumbers.Rows.CountLarge
          lngCols = rngNumbers.Columns.CountLarge
              
          'we don't need to shuffle if only a single cell was passed in
          If lngRows = 1 And lngCols = 1 Then
              ReDim dblarrOutPut(0 To 0)
              dblarrOutPut = rngNumbers.Value2
          Else
      
              'put the numbers into a 1 dimensional double array
              'if the cell is empty then 0 will be passed in
              'if the cell contains a value which can't be
              'converted to a double then an error will be thrown
              ReDim dblarrInput(0 To lngRows * lngCols - 1)
              
              For Each rngCell In rngNumbers.Cells
                  dblarrInput(i) = rngCell.Value2
                  i = i + 1
              Next rngCell
              
              'put the numbers in a random order
              Shuffle dblarrInput
              
              'transfer the numbers into our 2 dimensional output array
              ReDim dblarrOutPut(0 To lngRows - 1, 0 To lngCols - 1)
              
              For j = LBound(dblarrOutPut, 1) To UBound(dblarrOutPut, 1)
                  For k = LBound(dblarrOutPut, 2) To UBound(dblarrOutPut, 2)
                      dblarrOutPut(j, k) = dblarrInput(l)
                      l = l + 1
                  Next k
              Next j
              
          End If
          
          SHUFFLENUMBERS = dblarrOutPut
          
          Exit Function
      
      ErrorHandler:
      
          SHUFFLENUMBERS = CVErr(xlErrNum)
          
      End Function
      

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

      Like this

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s