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

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" <RikSmith@discussions.microsoft.com> wrote in message
news:6BF93F76-3513-434B-8DF2-D6CEE743D2DB@microsoft.com...
> 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

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" <RikSmith@discussions.microsoft.com> wrote in message
> news:6BF93F76-3513-434B-8DF2-D6CEE743D2DB@microsoft.com...
> > 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
>
>
>

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" <RikSmith@discussions.microsoft.com> wrote in message
news:6BE29351-EB25-4479-837F-7ECCAFC2B0CF@microsoft.com...
> 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" <RikSmith@discussions.microsoft.com> wrote in message
> > news:6BF93F76-3513-434B-8DF2-D6CEE743D2DB@microsoft.com...
> > > 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
> >
> >
> >

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" <RikSmith@discussions.microsoft.com> wrote in message
> news:6BE29351-EB25-4479-837F-7ECCAFC2B0CF@microsoft.com...
> > 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" <RikSmith@discussions.microsoft.com> wrote in message
> > > news:6BF93F76-3513-434B-8DF2-D6CEE743D2DB@microsoft.com...
> > > > 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
> > >
> > >
> > >
>
>
>