Shuffle an array in vba

Question

I need to shuffle values in array with no duplications, what do i need to add in my code to avoid duplications

Function Resample(data_vector)


   n = UBound(data_vector)
   ReDim shuffled_vector(n)
   For i = 1 To n
      shuffled_vector(i) = data_vector(WorksheetFunction.RandBetween(1, n))
   Next i
End Function

Scott Craner · Answer 1 · 2020-04-03T22:10:44.713

9

this will randomize the array:

Function Resample(data_vector() As Variant) As Variant()
    Dim shuffled_vector() As Variant
    shuffled_vector = data_vector
    Dim i As Long
    For i = UBound(shuffled_vector) To LBound(shuffled_vector) Step -1
        Dim t As Variant
        t = shuffled_vector(i)
        Dim j As Long
        j = Application.RandBetween(LBound(shuffled_vector), UBound(shuffled_vector))
        shuffled_vector(i) = shuffled_vector(j)
        shuffled_vector(j) = t
    Next i
    Resample = shuffled_vector
End Function

You can call like this:

Sub try()
    Dim x() As Variant
    x = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)

    x = Resample(x)

    MsgBox Join(x, ",")
End Sub

edited Apr 03 '20 at 22:10

answered Apr 03 '20 at 21:46

Scott Craner

148,073
10
49
81

Could you explain why (how) Application.Randbetween, and not Worksheetfunction.Randbetween and why not Rnd? What is what? – VBasic2008 Apr 03 '20 at 22:07
@VBasic2008 `Application.RandBetween` is the same as `Application.WorkSheetFunction.RandBetween` but it is late bound. I use it because it is less typing. As to why not rnd, well it is easier to understand and does not require fun math to get integers between two numbers. It is just my preference. – Scott Craner Apr 03 '20 at 22:10
1

@ScottCraner I know my tutor. I just wanted to notify you and I will delete the comments – YasserKhalil Apr 03 '20 at 22:15
Shouldn't or can't Dim t and Dim j go outside the loop? – VBasic2008 Apr 03 '20 at 22:20
There is nothing wrong with doing it that way. I prefer to keep my declarations and assignments together, it helps when coming back to code months later and knowing what is what. @VBasic2008 – Scott Craner Apr 03 '20 at 22:21
1

@VBasic2008 - `Dim` statements aren't executed; they are fine within the loop. – BigBen Apr 03 '20 at 22:22
This shuffle will be [bised](https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle). See my answer in the linked dup for a (mostly) unbiased alternative – chris neilsen Apr 03 '20 at 22:46
@chrisneilsen So changing the RandBetween to `j = Int((i + 1) * Rnd)` makes it unbiased? – Scott Craner Apr 03 '20 at 22:51
I think it would be (without studying to closely) `j = Application.RandBetween(LBound(shuffled_vector), i)`. – chris neilsen Apr 04 '20 at 00:44
1

Using worksheet functions is awful for performance and should always be avoided. To make this code **over 100× faster**, add this "one-liner" somewhere: `Function rndB(min,max): rndB=int((max-min)*rnd())+min: End Function` ...and then replace `Application.RandBetween` with `rndB`. Performance could probably be further improved by avoid so many calls to `UBound`/`LBound` by sticking their values into variables before the loop. – ashleedawg Jan 06 '22 at 19:03
1

Also, it's important to ***initialize* the random-number generator** with **[`Randomize`](https://learn.microsoft.com/office/vba/language/reference/user-interface-help/randomize-statement)** at the top of the procedure (no arguments needed). – ashleedawg Jan 06 '22 at 19:07

score 0 · Answer 2 · answered Apr 03 '20 at 21:46

Should the new array have the same dimension? try this:

Function Resample(data_vector)
   dim upper_bound as Long
   dim lower_bound as Long
   dim dict as Object
   dim i as Long
   dim lRandomNumber As Long
   Set dict = CreateObject("Scripting.Dictionary")

   upper_bound = UBound(data_vector)
   lower_bound  = LBound(data_vector)
   ReDim shuffled_vector(upper_bound)

   For i = 1 To upper_bound
      lRandomNumber = WorksheetFunction.RandBetween(1, upper_bound)
      If not dict.Exists(Cstr(lRandomNumber)) Then
           shuffled_vector(i) = data_vector(lRandomNumber)
           dict.Add Key:=Cstr(lRandomNumber), Item:=True
      Else
           lRandomNumber = GetNotUsedNumber(dict, lower_bound, upper_bound)
           shuffled_vector(i) = data_vector(lRandomNumber)
           dict.Add Key:=Cstr(lRandomNumber), Item:=True
      End If
   Next i
End Function


Pivate Function GetNotUsedNumber(byref dict as long, byref lower_bound as long, byref upper_bound as long)

dim i as Long
For i = lower_bound to upper_bound 
if not dict.exists(Cstr(i)) then
    iResult = i
    Exit For
end if
end function

see my two [comments](https://stackoverflow.com/questions/61020724/shuffle-an-array-in-vba#comment124825101_61020893) on the other answer since they apply to performance here too. — ashleedawg, Jan 06 '22 at 19:08

Shuffle an array in vba

2 Answers2

Linked