Shuffle Array
 

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

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

Shuffle Array
 

Tom, as always, you come up with the more efficient answer. The only thing
faster than your answer is your code. Monumentally faster than mine! Would
I be pushing my luck to challenge you to try again and keep it all in VBA
just for (my)learning's sake?

"Tom Ogilvy" wrote:

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

Shuffle Array
 

Use Donald Knuth's algorithm for a single pass shuffle.

Sub RandomizeRange()
Dim rng As Range
Set rng = Range("AList")
varr = Application.Transpose(rng)
varr1 = ShuffleArray(varr)
rws = UBound(varr1, 1) - LBound(varr1, 1) + 1
ReDim varr2(1 To rws, 1 To 1)
j = 1
For i = LBound(varr1) To UBound(varr1)
varr2(j, 1) = varr1(i)
j = j + 1
Next
rng.Offset(0, 1).Value = varr2
End Sub

Public Function ShuffleArray(varr)

'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139
'
'
Dim List() As Long
Dim t As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngTemp As Long

t = UBound(varr, 1) - LBound(varr, 1) + 1
ReDim List(1 To t)
For i = 1 To t
List(i) = varr(i)
Next
j = t
Randomize
For i = 1 To t
k = Rnd() * j + 1
lngTemp = List(j)
List(j) = List(k)
List(k) = lngTemp
j = j - 1
Next
ShuffleArray = List
End Function


--
Regards,
Tom Ogilvy

"Rik Smith" wrote in message
...
Tom, as always, you come up with the more efficient answer. The only
thing
faster than your answer is your code. Monumentally faster than mine!
Would
I be pushing my luck to challenge you to try again and keep it all in VBA
just for (my)learning's sake?

"Tom Ogilvy" wrote:

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

Shuffle Array
 

Works like a charm. Thanks for the insight!

"Tom Ogilvy" wrote:

Use Donald Knuth's algorithm for a single pass shuffle.

Sub RandomizeRange()
Dim rng As Range
Set rng = Range("AList")
varr = Application.Transpose(rng)
varr1 = ShuffleArray(varr)
rws = UBound(varr1, 1) - LBound(varr1, 1) + 1
ReDim varr2(1 To rws, 1 To 1)
j = 1
For i = LBound(varr1) To UBound(varr1)
varr2(j, 1) = varr1(i)
j = j + 1
Next
rng.Offset(0, 1).Value = varr2
End Sub

Public Function ShuffleArray(varr)

'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139
'
'
Dim List() As Long
Dim t As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngTemp As Long

t = UBound(varr, 1) - LBound(varr, 1) + 1
ReDim List(1 To t)
For i = 1 To t
List(i) = varr(i)
Next
j = t
Randomize
For i = 1 To t
k = Rnd() * j + 1
lngTemp = List(j)
List(j) = List(k)
List(k) = lngTemp
j = j - 1
Next
ShuffleArray = List
End Function


--
Regards,
Tom Ogilvy

"Rik Smith" wrote in message
...
Tom, as always, you come up with the more efficient answer. The only
thing
faster than your answer is your code. Monumentally faster than mine!
Would
I be pushing my luck to challenge you to try again and keep it all in VBA
just for (my)learning's sake?

"Tom Ogilvy" wrote:

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