<%
Sub Shuffle (ByRef arrInput)
    'declare local variables:
    Dim arrIndices, iSize, x
    Dim arrOriginal

    'calculate size of given array:
    iSize = UBound(arrInput)+1

    'build array of random indices:
    arrIndices = RandomNoDuplicates(0, iSize-1, iSize)

    'copy:
    arrOriginal = CopyArray(arrInput)

    'shuffle:
    For x=0 To UBound(arrIndices)
        arrInput(x) = arrOriginal(arrIndices(x))
    Next
End Sub

Function CopyArray (arr)
    Dim result(), x
    ReDim result(UBound(arr))
    For x=0 To UBound(arr)
        If IsObject(arr(x)) Then
            Set result(x) = arr(x)
        Else
            result(x) = arr(x)
        End If
    Next
    CopyArray = result
End Function

Function RandomNoDuplicates (iMin, iMax, iElements)
    'this function will return array with "iElements" elements, each of them is random
    'integer in the range "iMin"-"iMax", no duplicates.

    'make sure we won't have infinite loop:
    If (iMax-iMin+1)>iElements Then
        Exit Function
    End If

    'declare local variables:
    Dim RndArr(), x, curRand
    Dim iCount, arrValues()

    'build array of values:
    Redim arrValues(iMax-iMin)
    For x=iMin To iMax
        arrValues(x-iMin) = x
    Next

    'initialize array to return:
    Redim RndArr(iElements-1)

    'reset:
    For x=0 To UBound(RndArr)
        RndArr(x) = iMin-1
    Next

    'initialize random numbers generator engine:
    Randomize
    iCount=0

    'loop until the array is full:
    Do Until iCount>=iElements
        'create new random number:
        curRand = arrValues(CLng((Rnd*(iElements-1))+1)-1)

        'check if already has duplicate, put it in array if not
        If Not(InArray(RndArr, curRand)) Then
            RndArr(iCount)=curRand
            iCount=iCount+1
        End If

        'maybe user gave up by now...
        If Not(Response.IsClientConnected) Then
            Exit Function
        End If
    Loop

    'assign the array as return value of the function:
    RandomNoDuplicates = RndArr
End Function

Function InArray(arr, val)
    Dim x
    InArray=True
    For x=0 To UBound(arr)
        If arr(x)=val Then
            Exit Function
        End If
    Next
    InArray=False
End Function

'usage:
Dim arrTest
arrTest = Array(5, 8, 10, 15, 2, 30)
Call Shuffle(arrTest)
Response.Write(Join(arrTest, "<br />"))
%>