Help to Add loop to a VB code,Please..

[sezuh]

HI,
Happy New Year to you all.i have avb code working ok,but I would like to add a “ do until “ statement so all columns “A to J” have only non- consecutive numbers ,is that possible ?
Any suggestion would be appreciated.
Here is the code;

Sub generateuniquerandom()Dim b() As Boolean, e As Range, k&, x&
ReDim b(1 To 60)




For Each e In Range("a1:j6")
    Do
        x = Int(Rnd() * 60) + 1
        If b(x) = False Then
            e.Value = x
            b(x) = True
            Exit Do
         End If
        k = k + 1: If k > 1000 Then Exit Sub
     Loop






Next
Dim RgToSort As Range
Dim Rgcol As Range
Dim U As Long
Set RgToSort = Range(Range("A1:J6"), Range("A1:bez6").End(xlDown))


For Each Rgcol In RgToSort.Columns
    Rgcol.Sort Key1:=Range(Rgcol.Item(1).Address), Order1:=xlAscending, Orientation:=xlTopToBottom, OrderCustom:=1
Next
End Sub

an example of current result which i do not want;

[TABLE="width: 460"]
<colgroup><col span="10"></colgroup><tbody>[TR]
[TD="align: right"]7[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]14[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]19[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]17[/TD]
[TD="align: right"]37[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD="align: right"]22[/TD]
[TD="align: right"]27[/TD]
[TD="align: right"]16[/TD]
[TD="align: right"]21[/TD]
[TD="align: right"]32[/TD]
[TD="align: right"]26[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]23[/TD]
[TD="align: right"]44[/TD]
[TD="align: right"]31[/TD]
[/TR]
[TR]
[TD="align: right"]24[/TD]
[TD="align: right"]40[/TD]
[TD="align: right"]20[/TD]
[TD="align: right"]39[/TD]
[TD="align: right"]38[/TD]
[TD="align: right"]34[/TD]
[TD="align: right"]33[/TD]
[TD="align: right"]29[/TD]
[TD="align: right"]45[/TD]
[TD="align: right"]42[/TD]
[/TR]
[TR]
[TD="align: right"]36[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]49[/TD]
[TD="align: right"]41[/TD]
[TD="align: right"]53[/TD]
[TD="align: right"]35[/TD]
[TD="align: right"]48[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]59[/TD]
[TD="align: right"]46[/TD]
[/TR]
[TR]
[TD="align: right"]47[/TD]
[TD="align: right"]56[/TD]
[TD="align: right"]57[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]58[/TD]
[TD="align: right"]51[/TD]
[TD="align: right"]54[/TD]
[TD="align: right"]50[/TD]
[TD="align: right"]60[/TD]
[TD="align: right"]52[/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG04Jan52
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] x [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nstr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
Application.ScreenUpdating = False
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1:J6")
Rng.ClearContents
Randomize
[COLOR="Navy"]Do[/COLOR] Until Application.CountA(Rng) = 60
nxt: c = 0
    ReDim b(1 To 60) [COLOR="Navy"]As[/COLOR] Boolean
    Rng.ClearContents
    nstr = ""
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 10
        nstr = ""
        [COLOR="Navy"]For[/COLOR] n = 1 To 6
            x = Int(Rnd() * 60) + 1
                [COLOR="Navy"]Do[/COLOR] Until InStr(nstr, x + 1) = 0 And _
                InStr(nstr, x - 1) = 0 And b(x) = False
                    x = Int(Rnd() * 60) + 1
                    c = c + 1
                    [COLOR="Navy"]If[/COLOR] c > 1000 [COLOR="Navy"]Then[/COLOR] GoTo nxt
                [COLOR="Navy"]Loop[/COLOR]
                    nstr = nstr & "#" & x & "#"
                    b(x) = True
                    Cells(n, Ac) = x
        [COLOR="Navy"]Next[/COLOR] n
 Cells(1, Ac).Resize(6).Sort Cells(1, Ac), xlAscending
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Loop[/COLOR]
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sezuh]

Mick,
your determination is admirable,the code works perfect.
Thanks ever so much for your time and invaluable help,much appreciated.
Is it possible for you to explain this part of the code,please?thank you.

  nstr = ""    For Ac = 1 To 10
        nstr = ""
        For n = 1 To 6
            x = Int(Rnd() * 60) + 1
                Do Until InStr(nstr, x + 1) = 0 And _
                InStr(nstr, x - 1) = 0 And b(x) = False
                    x = Int(Rnd() * 60) + 1
                    c = c + 1
                    If c > 1000 Then GoTo nxt
                Loop
                    nstr = nstr & "#" & x & "#"
                    b(x) = True
                    Cells(n, Ac) = x

 

[MickG]

You're welcome.
What that bit of code does is create a string "nStr" of each cell in each individual columns from the random number "x", then checks the next random number against that string using the "Instr" function, ensuring its not sequential. if Ok it places the value in the cell and adds the random number x to "nStr" to check against the next random number. If not it runs the inner loop again

It is inevitable that at some point it may not be possible to complete the set because there are not the right combinations left.
when this happens (after "C" get to 1000) the code reverts to "nxt" a the top of the code and runs the outer loop again, until the correct numbers are found.
The "#" in the string "nStr" is to separate each number, else you could get numbers like 6 being found in number 60 or similar

 

[sezuh]

Thanks for the information,it help me to understand how your code works,i think!
Anyway, very much appreciated,for all your help and time have a very good day.

 

[MickG]

Thanks for the feedback
Regrds Mick