Random Sequencing

[Vickyy]

Hello all,

I am looking for help with this vba problem i have.

I have a system that accepts 3 types of demand in bulk. Each bulk has quantities in it. I have been able to split this quantities randomly from 1 to 5 splits before going into the system sequencially. But now i want these splits to go in a random sequence with no same type following each other.
For example

Type 1: 5 quantities; splitted into 2,3
Type 2: 7 quantities; splitted into 3,4
Type 3: 6 quantities; splitted into 1,1,1,1,2

And they go into the system in that sequence: 2,3,3,4,1,1,1,1,2

But i want to sequence to be random with no two of the same type following each other.

Please how can I achieve this with code.

Thanks

 

[NauticalGent]

Look into the MOD function. You would have to do some code to determine your individual numbers.

For example you type 3 example. You are dividing 6 by 5, which gives you 1 with 1 remaining. 5x1 gives you the 5 "1"s. 6 MOD 5 returns the remainder, which is one. You would add this to the last "1" which would give you 2.

Kind of convoluted, but I am not really sure what you are after...

 

[Frothingslosh]

But i want to sequence to be random with no two of the same type following each other.

Not logically possible - by definition, a random sequencing must allow for the possibility of the same types being consecutive.

Instead of this one line description, I would suggest you start by making a set of rules to cover when types are eligible for selection, when they're not, what to do if you have more of one type than the others combined (if you have 1 T1, 2 T2, and 5 T3, it is literally impossible to not have consecutive T3), etc. How do you get the system to tell when a 'random' selection MUST be a type with far more members than the other types? Does the 'random' aspect outweigh the 'no duplication' aspect, or is it more important that there be no duplication, even if it means selection is far from random? (You and I can see that the sequence MUST start with T3, and be comprised of T3 alternating with T1 and T2, but a computer has to be told that.)

While it's easy to do what you're asking by hand, I think you're going to find that the logic involved will be quite involved when you try to implement it through VBA. Random assignments are easy; semi-random assignments insuring that each batch stays within a certain limit of each other aren't that hard, either. What you're asking for is, I'm afraid, an entirely different kettle of fish.

 

[Vickyy]

Hello,

please find attached file for clarification

Thanks

 

[Vickyy]

Instead of this one line description, I would suggest you start by making a set of rules to cover when types are eligible for selection, when they're not, what to do if you have more of one type than the others combined (if you have 1 T1, 2 T2, and 5 T3, it is literally impossible to not have consecutive T3), etc.

Hello thanks for your response and suggestion. I attached a file for some clarification of the problem....Is it useful/

Thanks

 

[Frothingslosh]

I can look into it after work if no one else beats me to it. No telling when I'll get home, though, thanks to the roads, but it'll be at least 6pm Eastern.

 

[Vickyy]

I can look into it after work if no one else beats me to it. No telling when I'll get home, though, thanks to the roads, but it'll be at least 6pm Eastern.

Thank you so much, I will be waiting.

Regards

 

[static]

This creates a recordset, with a random 'index' for sorting.
Since the order can't be guaranteed it checks the order and if it finds a valid sequence prints it to debug.

Const QUIT_AFTER As Byte = 10

Private Sub Command0_Click()
    GetSeq
End Sub

Private Sub GetSeq()
    Dim rs As New ADODB.Recordset, i As Long
    
    i = 1
    Do
        Set rs = GenRs
        RandRS rs
        If ChkRS(rs) Then
            'success - print
            PrtRS rs
            Debug.Print ">> attempts " & i
            Exit Do
        Else
            i = i + 1
            If i > QUIT_AFTER Then
                Debug.Print "no sequence found"
                Exit Do
            End If
        End If
    Loop
End Sub

Private Function GenRs() As ADODB.Recordset
    'create new recordset
    Dim rs As New ADODB.Recordset, f As ADODB.Field, a(2)
    rs.Fields.Append "type", adVarChar, 5
    rs.Fields.Append "split", adInteger
    rs.Fields.Append "ord", adInteger
    rs.Fields.Append "rand", adInteger
    rs.Open
    
    'add values and set random sort order
    Dim fl(): fl = Array(0, 1, 3)
    rs.AddNew fl, Array("type1", 2, CInt(Rnd * 1000))
    rs.AddNew fl, Array("type1", 1, CInt(Rnd * 1000))
    rs.AddNew fl, Array("type1", 2, CInt(Rnd * 1000))
    rs.AddNew fl, Array("type1", 5, CInt(Rnd * 1000))
    
    rs.AddNew fl, Array("type2", 2, CInt(Rnd * 1000))
    rs.AddNew fl, Array("type2", 3, CInt(Rnd * 1000))
    
    rs.AddNew fl, Array("type3", 2, CInt(Rnd * 1000))
    rs.AddNew fl, Array("type3", 2, CInt(Rnd * 1000))
    rs.AddNew fl, Array("type3", 3, CInt(Rnd * 1000))
    
    rs.Sort = "rand"
    Set GenRs = rs
End Function

Private Sub RandRS(ByRef rs As ADODB.Recordset)
    'set a sequence order for each group
    setord rs, "type1"
    setord rs, "type2"
    setord rs, "type3"
    rs.Filter = ""
    rs.Sort = "ord,rand"
End Sub

Private Sub setord(rs As ADODB.Recordset, id As String)
    rs.Filter = "[type]='" & id & "'"
    Do Until rs.EOF
        i = i + 1
        rs.Fields(2) = i
        rs.MoveNext
    Loop
End Sub

Private Function ChkRS(rs As ADODB.Recordset) As Boolean
    'retn false if not valid sequence
    ChkRS = Not rs.EOF
    Do While Not rs.EOF And ChkRS
        ChkRS = rs(0) <> lastval
        If ChkRS Then lastval = rs(0)
        rs.MoveNext
    Loop
    
End Function

Private Function PrtRS(rs As ADODB.Recordset) As Boolean
    'print result
    rs.MoveFirst
    Do While Not rs.EOF
        Debug.Print rs(0), rs(1) ', rs(2), rs(3)
        rs.MoveNext
    Loop
End Function

 

[supmktg]

This function should help you generate a random bulk type between 1 and 3. Put it into a module and call it each time you need to generate the next type. The public variable iLastBulk will hold the last type and prevent 2 of the same type in a row.

Public iLastBulk as Integer

Function BulkRandom() As Integer 
Dim i As Integer
Dim iNewBulk As Integer


    Do Until iNewBulk <> iLastBulk And iNewBulk > 0
        iNewBulk = Int((3 - 1 + 1) * Rnd + 1)
    Loop

    iLastBulk = iNewBulk
    BulkRandom = iNewBulk
'MsgBox BulkRandom
End Function

I hope this helps,
Sup

 

[Frothingslosh]

It looks like Static has you covered.