Shuffle Array
if you want the shuffled list to the right of the Alist
Sub ABC()
Dim v As Variant
With Worksheets("Sheet1")
With .Range("AList")
v = .Value
.Offset(0, 1).Formula = "=Rand()"
.Resize(, 2).Sort Key1:=.Offset(0, 1)
.Offset(0, 1).Value = .Value
.Value = v
End With
End With
End Sub
--
Regards,
Tom Ogilvy
"Rik Smith" wrote in message
...
Hello all,
I usually find the answers I'm looking for without having to post them.
So
I'd like to thank you all for all the help you've given me, you have no
idea
how helpful you've been.
Since I'm relatively new at this, I was wondering if there was a better
way
to (pseudo)randomly shuffle an array than what I've come up with. The
code
is posted below. If any of you have some advice, I'd love to hear it.
Thanks!
Sub BuildAlistArr()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim arrAList As Variant, arrRnd As Variant, arrBList As Variant
Dim i As Long, j As Long
Dim flag As Boolean
Dim x As Long, y As Long, z As Long
With Worksheets("Sheet1")
With .Range("AList")
ReDim arrAList(.Cells.Count - 1)
For i = LBound(arrAList) To UBound(arrAList)
arrAList(i) = .Cells(i + 1)
Next
End With
x = LBound(arrAList)
y = UBound(arrAList)
z = y - x
ReDim arrRnd(y)
ReDim arrBList(y)
Randomize
For i = x To y
Do
arrRnd(i) = Int((y - x + 1) * Rnd + x) 'Unique Random Number
For j = x To i
flag = False
If arrRnd(i) = arrRnd(j) And i < j Then
flag = True
Exit For
End If
Next
Loop Until Not flag
arrBList(i) = arrAList(arrRnd(i))
.Cells(i + 2, 3).Value = arrBList(i)
Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
|