Shuffle an Array?

[User Name]

I'd like to build an array with the days of the month randomly sorted. i.e. Neglecting leap year I'd like 1 to 28 for February, 1 to 30 for June or 1 to 31 for January randomly sorted.

Any ideas?

 

[shg]

In an convenient column, enter =RAND() and copy down. Sort by that.

 

[User Name]

Ahhh....Thanks but I need to shuffle an array in VBA. I'd use rnd to fill up one column but I don't know how to sort by this column.

 

[shg]

Well then ...

Sub x()
    Dim aiFeb() As Long
    
    aiFeb = aiRandLong(1, 28)
End Sub
 
Public Function aiRandLong(iMin As Long, _
                           iMax As Long, _
                           Optional ByVal n As Long = -1, _
                           Optional bVolatile As Boolean = False) As Long()
    ' UDF or VBA
 
    ' Adapted from Chip Pearson at [URL]http://www.cpearson.com/excel/RandomNumbers.aspx[/URL]
    ' Returns a 1-based array of n unique Longs between iMin and iMax inclusive

    Dim aiSrc()     As Long
    Dim aiOut()     As Long
    Dim iSrc        As Long
    Dim iOut        As Long
    Dim iTop        As Long
 
    If bVolatile Then Application.Volatile
 
    If n = -1 Then n = iMax - iMin + 1
    If iMin > iMax Or n > (iMax - iMin + 1) Or n < 1 Then Exit Function
 
    ReDim aiSrc(iMin To iMax)
    ReDim aiOut(1 To n)
 
    ' init iSrc
    For iSrc = iMin To iMax
        aiSrc(iSrc) = iSrc
    Next iSrc
 
    iTop = iMax
    For iOut = 1 To n
        ' pick a number between 1 and iTop, swap with iTop, decrement iTop
        iSrc = Int((iTop - iMin + 1) * Rnd) + iMin
        aiOut(iOut) = aiSrc(iSrc)
        aiSrc(iSrc) = aiSrc(iTop)
        iTop = iTop - 1
    Next iOut
 
    aiRandLong = aiOut
End Function

 

[mikerickson]

Try this function.

Function scrambledArray(unscrambledArray As Variant) As Variant
    Dim workingArray As Variant
    Dim Size As Long, i As Long, ii As Long
    Dim randIndex As Long, temp As Variant
    
    workingArray = unscrambledArray
    Size = UBound(workingArray) - LBound(workingArray) + 1
    
    
    For i = LBound(workingArray) To UBound(workingArray)
        Randomize
        randIndex = Int(Size * Rnd()) + LBound(workingArray)
        
        temp = workingArray(randIndex)
        workingArray(randIndex) = workingArray(i)
        workingArray(i) = temp
    Next i
    
    scrambledArray = workingArray
End Function

Sub test()
    Dim i As Long
    For i = 1 To 10
        Range("A65536").End(xlUp).Offset(1, 0) = Join(scrambledArray(Array(1, 2, 3, 4, 5)))
    Next i
End Sub

 

[User Name]

Thank you for the suggestions. I'm stumped by them at the moment but they will probably make sense in the morning. One question, why is this code written as a function?

CDF_Step = 1
Day = 1
Dim KT_Array(0 To 31) As Variant
Dim Number_Array(0 To 31) As Variant
        
Do While CDF_Step < Month_step
        
'Townsend's solution for daily Kt values - S1272
KT_Day = 1 / Gamma_X * Log((1 - CDF_Step / Month_step) * _
e ^ (Gamma_X * 0.05) + CDF_Step / Month_step * e ^ (Gamma_X * KT_Max))
            
KT_Array(Day) = KT_Day
Number_Array(Day) = Day
Day = Day + 1
CDF_Step = CDF_Step + 2
            
Loop

The array I want to scramble is the Number_Array. Then I want to sort the KT_Array in the same order as the scrambled Number_Array.

 

[mirabeau]

If you just want to shuffle the day numbers from 1 to 30 (or 1 to 28, or 1 to 31) with a straight sub and without a helper column, then there's a number of ways, e.g.

Sub shuffle()
Dim b() As Boolean, a, n&, x&, k&
n = 30
ReDim b(1 To n), a(1 To n, 1 To 1)
Do
    x = Int(Rnd * n) + 1
    If Not b(x) Then
        k = k + 1
        a(k, 1) = x
        b(x) = True
    End If
Loop Until k = n
[c1].Resize(n) = a
End Sub

 

[User Name]

Got that one working in 10 minutes... Thank you.