Random Shuffle Array Function

Category:

Dates and Math

Type:

Snippets

Difficulty:

Beginning

Author:

Anonymous

Version Compatibility: Visual Basic 6, Visual Basic 5, Visual Basic.NET

More information:

How to use : Copy & paste the code into your class. Pass any 1 dimensional array to the function, and it will shuffle the elements of the array. Example: dim arrNums(1,2,3,4,5) as integer arrNums = Shuffle(arrNums) arrNums = (3,1,5,2,4)

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Public Function Shuffle(ByVal Array() As Object) As Object() 'Returns Array 
        Dim intUBound As Integer
        Dim intHUBound As Integer
        Dim intRanNum As Integer
        Dim a() As Object
        Dim b() As Object
        Dim i As Integer
        Dim blnError As Boolean

'Starts the randon deck Shuffle
        intUBound = UBound(Deck)
        intHUBound = intUBound

ReDim a(intUBound)
        ReDim b(intUBound)

'On Error GoTo e

For i = 0 To intUBound
            a(i) = Array(i) ' Sets array (a) list to (1 to cntnum)

Next i

Randomize() ' Activates the Random Number Generator
            intRanNum = Int(Rnd() * intUBound) ' Picks a Random number between 0 and max number
            b(0) = a(intRanNum)

Try
                For i = 1 To intUBound ' Starts a loop
                    If intRanNum = intUBound Then intRanNum = -1 ' If the Random number = max number then the Random number becomes 0
                    intRanNum += 1  ' Adds 1 to the Random number
                    b(i) = a(intRanNum) ' b(current loop value) = The current Random number

Next i ' Adds 1 to i and loops until i is greater than the max Number

For i = 0 To intUBound
                    a(i) = b(i) ' Makes array a the same as array b
                Next i

intUBound -= 1 ' Subtracts 1 from the max number
            Catch
                'If any error has occured the user is warned
                MsgBox("An Error has occured, Outcome may not be acurate", MsgBoxStyle.Critical, "Error")
            End Try
        Loop Until intUBound = -1
        Return (a)
    End Function