Shuffle Array VBA

[Tzarevna]

I have an array {1;2;3;4;5;6;7;8;9;10} in range of A1:A10. My goal is to shuffle this array in a random order. I have a function in VBA that should do this. I am a newbie to VBA. I do not understand how can i check this code out.. I press "run" but VBA does not show me this macro in the list of macros. I try run from an Excel Worksheet by typing: =ShuffleArray(A1:A10) but i receive the error "#VALUE!". Please explain me who knows how to solve this issue. The code of the function is:


Function ShuffleArray(InArray() As Variant) As Variant()
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim Arr() As Variant
Randomize
L = UBound(InArray) - LBound(InArray) + 1
ReDim Arr(LBound(InArray) To UBound(InArray))
For N = LBound(InArray) To UBound(InArray)
Arr(N) = InArray(N)
Next N
For N = LBound(InArray) To UBound(InArray)
J = CLng(((UBound(InArray) - N) * Rnd) + N)
Temp = Arr(N)
Arr(N) = ARr(J)
Arr(J) = Temp
Next N
ShuffleArray = Arr
End Function

[mancubus]

welcome to vbax.

link to the original web site:
http://www.cpearson.com/excel/ShuffleArray.aspx

and a workaround:
http://www.mrexcel.com/forum/excel-questions/418911-shuffle-array.html

[ranman256]

Is must be a SUB, not a function to show, and you cant pass it parameters, to you need a SUB to call the function to pass the params.

[snb]

Sub M_snb()
Randomize
sn = Array(Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd)
sp = sn

For j = 1 To 10
sp(j - 1) = Application.Match(Application.Large(sn, j), sn, 0)
Next
Cells(1, 6).Resize(10) = Application.Transpose(sp)
End Sub

[snb]

or

Sub M_snb()
[A1:A10] = "=rand()"
[A1:A10] = [index(rank(A1:A10,A1:A10),)]
End Sub

[GTO]

Just another try and not well tested I am afraid...

In a Standard Module:



Option Explicit

Function ShuffleUDF(MyRange As Range) As Variant
Dim arrTmpIn As Variant
Dim arrTmpOut() As Variant
Dim arrIndexes() As Long
Dim n As Long

Application.Volatile

If DimensionCount(MyRange.Value) = 2 Then

If UBound(MyRange.Value, 1) = 1 Then
arrIndexes() = GetRnds(UBound(MyRange.Value, 2))
arrTmpIn = MyRange.Value
ReDim arrTmpOut(1 To 1, 1 To UBound(arrTmpIn, 2))

For n = 1 To UBound(arrTmpOut, 2)
arrTmpOut(1, n) = arrTmpIn(1, arrIndexes(n))
Next

Else
arrIndexes() = GetRnds(UBound(MyRange.Value, 1))
arrTmpIn = MyRange.Value
ReDim arrTmpOut(1 To UBound(arrTmpIn), 1 To 1)

For n = 1 To UBound(arrTmpOut)
arrTmpOut(n, 1) = arrTmpIn(arrIndexes(n), 1)
Next
End If

ShuffleUDF = arrTmpOut

Else
ShuffleUDF = "YIKES!"
End If

End Function

Function GetRnds(ElementCount As Long) As Long()
Dim arrTmp() As Long
Dim arrTmp2() As Long
Dim n As Long
Dim y As Long
Dim Index As Long

ReDim arrTmp(1 To ElementCount)
ReDim arrTmp2(1 To ElementCount)

For n = 1 To ElementCount
arrTmp(n) = n
Next

Randomize

For n = 1 To ElementCount

Index = Int(UBound(arrTmp, 1) * Rnd + 1)

arrTmp2(n) = arrTmp(Index)

If n < ElementCount Then
For y = Index To UBound(arrTmp) - 1
arrTmp(y) = arrTmp(y + 1)
Next
ReDim Preserve arrTmp(1 To UBound(arrTmp) - 1)
End If

Next

GetRnds = arrTmp2

End Function

' See about post 5, Bob Phillips response at:
' http://answers.microsoft.com/en-us/office/forum/office_2003-excel/how-many-vba-array-dimensions/a4c80919-3cd3-4ed0-a173-b9b8fabd3c83
Function DimensionCount(vArray As Variant) As Long
Dim i As Long

On Error Resume Next
Do
i = i - (LBound(vArray, i + 1) * 0 = 0)
Loop Until Err.Number
On Error GoTo 0

DimensionCount = i

End Function

[Tzarevna]

Thank you very much for such helpful and complete answers !!! I learned a lot with your help! =) :friends: