+ Reply to Thread
Results 1 to 5 of 5

Shuffle Array

  1. #1
    Rik Smith
    Guest

    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

  2. #2
    Tom Ogilvy
    Guest

    Re: 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" <[email protected]> wrote in message
    news:[email protected]...
    > 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




  3. #3
    Rik Smith
    Guest

    Re: 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" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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

    >
    >
    >


  4. #4
    Tom Ogilvy
    Guest

    Re: 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" <[email protected]> wrote in message
    news:[email protected]...
    > 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" <[email protected]> wrote in message
    > > news:[email protected]...
    > > > 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

    > >
    > >
    > >




  5. #5
    Rik Smith
    Guest

    Re: 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" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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" <[email protected]> wrote in message
    > > > news:[email protected]...
    > > > > 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
    > > >
    > > >
    > > >

    >
    >
    >


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1