Array Shuffle

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 />"))