Public Function randomArr(sourceArr As Range) As Variant
Dim str As String, lPos As Long, lm As Long, arr As Variant, dArr As Variant
arr = sourceArr.Value
ReDim dArr(1 To UBound(arr), 1 To 1)
str = Join(WorksheetFunction.Transpose(Evaluate("=row(A1:A" & UBound(arr) + 1 & ")")), ",")
Randomize
lm = InStrRev(str, ",")
Do While lm > 0
lPos = InStr(Int(lm * Rnd + 1), str, ",")
lPre = InStrRev(str, ",", lPos - 1)
k = k + 1
dArr(k, 1) = arr(Mid(str, lPre + 1, lPos - lPre - 1), 1)
str = Left(str, lPre) & Mid(str, lPos + 1)
lm = InStrRev(str, ",")
Loop
randomArr = dArr
End Function