Shuffle an Array

[S.H.A.D.O.]

Good evening,

For what I am trying to do it appears that I need a Sub that "Shuffles" an array.
I have been surfing the web but unfortunately I can't find one that accommodates exactly what I am after. I basically want to be able to designate the size of the array (e.g. 34 numbers or 40 numbers or 45 numbers etc) and then choose whether I want them listed as 4 number combinations, 5 number combinations or 6 number combinations for example starting in cell "B2".

For example: If I was to use 34 numbers and produce 5 number combinations ...

combination 1 would be in cells B2:F2 ( 5 Numbers )
combination 2 would be in cells B3:F3 ( 5 Numbers )
...
combination 6 would be in cells B7:F7 ( 5 Numbers )
combination 7 would be in cells B8:E8 ( 4 Numbers )

If anyone has any ideas I would be grateful.

 

[seboseszuk]

Hello S H A D O,

I don't understand what you mean by shuffle.
It would really be helpful if you gave an example.
Do you have an array of single digit numbers in b2:F2 to Bxxx:Fxxx.

Regards,

Gabor

 

[S.H.A.D.O.]

Thanks for the reply Gabor.
The Excel sheet is empty awaiting the data from the Sub.
I want the Sub Array to hold say 34 numbers or whatever and then shuffle ( Randomize ) them and output them into the Excel sheet in the cells described.
Thanks.

 

[S.H.A.D.O.]

Hi Gabor,

The result could possibly be as follows if using say 40 numbers ...

B2:F2 29 21 23 11 37 28
B3:F3 1 26 27 22 2 13
B4:F4 25 31 10 35 39 30
B5:F5 24 8 36 15 34 20
B6:F6 32 5 9 14 4 12
B7:F7 40 16 19 7 6 38
B8:E8 3 17 18 33


... this is obviously one of the numerous outputs that could be produced randomly.
The above includes ALL 40 numbers of the Array if we were to use 40 numbers and they are randomly sorted and output as above.
Thanks.

 

[seboseszuk]

Hello S.H.A.D.O,

this is my interpretation of your desired program:
Have n (34, 40, etc.)numbers in column A.
Randomly assign it to m rows( starting in column B) each consisting of 2,3,4,5 etc. numbers.
A remainder line may have fewer numbers than contained in the m rows.

Your last note speaks about 6 numbers/row which would make it B2:G2 not
B2:F2 as you wrote.

best regards,

Gabor

 

[seboseszuk]

Hello SHADO

My interpretation is

Have n numbers in columns A
Assign numbers randomly into m rows ( starting in column B) each consisting of 3,4,5,etc. numbers/row.
A remainder row with fewer numbers is possible.

Your last note list 6 numbers B2:F2 ????

best regards

Gabor

 

[S.H.A.D.O.]

Hi Gabor,

There are no numbers at the start in the spreadsheet, it is blank.
I would like to have the 34 or 40 or 42 or whatever numbers in the Sub Array itself and then shuffle ( Randomize ) the Array and output the numbers to the spreadsheet starting in cell "B2" to cell ? depending on whether they are 3 or 4 or 5 or whatever size combinations, then drop down to the next row and do the same again, then continue doing this until ALL the numbers from the Shuffled ( Randomized ) Array have been output to the spreadsheet, of course there will be no duplicates.
So if I was to use 34 numbers there would be 34 cells of data output.
Thanks for your time on this.

 

[MickG]

Try this:-
At the top of the code you will see the Variables "ColNum & RowNum" , if you change these values for the rows & columns you want, the code wil provide an array of randomized numbers in that Matrix.

Dim Ray    As Variant
Dim num    As Integer
Dim n      As Integer
Dim txt    As String
Dim Rw     As Integer
Dim TxRay() As String
Dim c      As Integer
Dim rws    As Integer
Dim Col As Integer
Dim ColNum As Integer
Dim RwNum As Integer
ColNum = 4
RwNum = 8
Ray = Evaluate("row(1:" & ColNum * RwNum & ") ")
rws = UBound(Ray, 1)
Randomize
For Col = 1 To rws / RwNum
    For Rw = 1 To rws / ColNum
        c = 0
        If Rw = RwNum And Col = ColNum Then
            Cells(Rw, Col) = Ray(1) ':
            Exit Sub
        Else
            num = Int(Rnd * UBound(Ray)) + 1
            Cells(Rw, Col) = Ray(num, 1)
        End If
For n = 1 To UBound(Ray, 1)
    If Not Ray(n, 1) = Ray(num, 1) Then
        ReDim Preserve TxRay(c)
        TxRay(c) = n
        c = c + 1
    End If
Next n
Ray = Application.Index(Ray, Application.Transpose(Array(TxRay)))
Erase TxRay
Next Rw
Next Col
End Sub

Mick

 

[S.H.A.D.O.]

Thanks for the reply Mick.
The code works great except for the fact that if I wanted to use say 34 numbers and go 6 numbers across I cannot adapt the code to accomodate this to use exactly 34 numbers.
If I was to use 34 numbers and going 6 numbers across the output should be 5 rows of 6 numbers and 1 row of 4 numbers.
Thanks in advance.

 

[MickG]

Try this:-
Place the Total Number in "A1" and the Columns in "B1".
NB:- Try in New sheet, this code will clear the sheet of data.

[COLOR=navy]Sub[/COLOR] MG09Sep08
[COLOR=navy]Dim[/COLOR] Ray     [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] num     [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] n       [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] txt     [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] Rw      [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] TxRay() [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] c       [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] rws     [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Col     [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] ColNum  [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] RwNum   [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Ac      [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Dn      [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
RwNum = [A1]
ColNum = [b1]
Cells.ClearContents
Range("A1") = RwNum
Range("B1") = ColNum
Ray = Evaluate("row(1:" & RwNum & ") ")
rws = UBound(Ray, 1)
Randomize
ReDim nRay(1 To rws)
[COLOR=navy]For[/COLOR] Rw = 1 To rws
        c = 0
        [COLOR=navy]If[/COLOR] Rw = rws [COLOR=navy]Then[/COLOR]
            nRay(Rw) = Ray(1)
            [COLOR=navy]Exit[/COLOR] For
        [COLOR=navy]Else[/COLOR]
            num = Int(Rnd * UBound(Ray)) + 1
            nRay(Rw) = Ray(num, 1)
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]For[/COLOR] n = 1 To UBound(Ray, 1)
    [COLOR=navy]If[/COLOR] Not Ray(n, 1) = Ray(num, 1) [COLOR=navy]Then[/COLOR]
        ReDim Preserve TxRay(c)
        TxRay(c) = n
        c = c + 1
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n
Ray = Application.Index(Ray, Application.Transpose(Array(TxRay)))
Erase TxRay
[COLOR=navy]Next[/COLOR] Rw
Dn = 2
[COLOR=navy]For[/COLOR] n = 1 To UBound(nRay)
    Ac = Ac + 1
    [COLOR=navy]If[/COLOR] Ac = ColNum + 1 [COLOR=navy]Then[/COLOR]
        Dn = Dn + 1
        Ac = 1
    [COLOR=navy]End[/COLOR] If
        Cells(Dn, Ac) = nRay(n)
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick