help modifiying code

[abberyfarm]

Hi there,

Would anybody be able to help me make a slight modification to the code below.

[LEFT]Sub RandomQuicker()
Dim a&, b&, c&, i&, j&, tbl()
Randomize
For i = 2 To 10
   If Cells(i, 1).Value = 1 Then
     Cells(i, 3).Value = Cells(i, 2).Value
   Else
     If Cells(i, 1).Value = 2 Then
       Cells(i, 3).Value = Int(1 + Rnd * Cells(i, 2).Value)
       Cells(i, 4).Value = Cells(i, 2).Value - Cells(i, 3).Value
     Else
       a = Cells(i, 1).Value
       b = Cells(i, 2).Value
       ReDim Preserve tbl(1 To a - 1)
       
       For j = 1 To a - 1
         tbl(j) = Int((1 + b * Rnd))
       Next j
       
       c = Application.Sum(tbl)
       
       For j = 1 To a - 1
         tbl(j) = Int(tbl(j) / (1.1 * c) * b)
       Next j
       
       c = Application.Sum(tbl)
       
       ReDim Preserve tbl(1 To a)
       tbl(a) = b - c
       Cells(i, 3).Resize(, UBound(tbl)) = tbl
     End If
   End If
Next i
End Sub



[/LEFT]

This code divides up the total distance travelled into individual journey distances based on the number of journeys.

Excel Workbook
	A	B	C	D	E	F
1	No .Trips	Total travel	Individual travel
2	2	10	5	15
3	3	20	3	5	12
4	4	40	5	10	12	13
Sheet1

I need to prevent it from generating 0 as a random number as 0 distance would not make sense. I believe I need to change the conditions for the array tbl, but I am not entirely sure.

Thank for help

John

 

[Mohammad Basem]

Hi John,

Does this help as an alternative?

[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Option Explicit

Sub RandomQuicker()

    Dim tbl()
    Dim iTrips As Integer, iSum As Integer
    Dim lRow As Long, lLastRow As Long
    Dim dRnd As Double

    lLastRow = Range("A" & Rows.Count).End(xlUp)
    Randomize
    For lRow = 2 To lLastRow
        ReDim tbl(1 To Cells(lRow, 1))
[COLOR="Green"]        '*
        '* Generate random number within the limit of the value column B[/COLOR]
        For iTrips = 1 To Cells(lRow, 1)
            dRnd = Rnd
            tbl(iTrips) = IIf(Int(dRnd * Cells(lRow, 2) / Cells(lRow, 1)) = 0, 1, Int(dRnd * Cells(lRow, 2) / Cells(lRow, 1)))
        Next iTrips
[COLOR="Green"]        '*
        '* Apply correction factor, if need be[/COLOR]
        iSum = Application.Sum(tbl)
        If iSum <> Cells(lRow, 2) Then
            For iTrips = 1 To Cells(lRow, 1)
                tbl(iTrips) = Round(Cells(lRow, 2) / iSum * tbl(iTrips), 0)
            Next iTrips
        End If
[COLOR="Green"]        '*
        '* If still some differences, distribute amongst tbl elements[/COLOR]
        iSum = Application.Sum(tbl)
        If iSum <> Cells(lRow, 2) Then
            For iTrips = 1 To Cells(lRow, 1)
                If iSum > Cells(lRow, 2) Then
                    tbl(iTrips) = tbl(iTrips) - 1
                    iSum = iSum - 1
                Else
                    tbl(iTrips) = tbl(iTrips) + 1
                    iSum = iSum + 1
                End If
                If iSum = Cells(lRow, 2) Then Exit For
            Next iTrips
        End If
        Cells(lRow, 3).Resize(, Cells(lRow, 1)) = tbl
    Next lRow

End Sub[/COLOR][/SIZE][/FONT]

 

[abberyfarm]

Hello Mohammad,

Thank you very much for your help. This works perfect.

Regards

John

 

[Mohammad Basem]

Al-hamdullah, you are most welcome and thank you for the feedback!
Best regards

 

[abberyfarm]

Hello Mohammad,

Thank you for help recently with this problem.

Would you mind explaining to me briefly how the code works? I've tried to understand it but I cannot follow it.

Do you begin by generating one random number within the limit of column B? what happens next? what is the correction factor?

Kind Regards

John

 

[Mohammad Basem]

Hi John,

I’ll give it a try, in-sha’ Allah, and explain by example, hoping this make things clearer.

Considering the second option in your example; Number of trips = 3 and number of travels = 20.

[FONT=Consolas][SIZE=2][COLOR=Navy][COLOR=Green]'*
'* Generate random number within the limit of the value column B[/COLOR]
For iTrips = 1 To Cells(lRow, 1)
    dRnd = Rnd
    tbl(iTrips) = IIf(Int(dRnd * Cells(lRow, 2) / Cells(lRow, 1)) = 0, 1, Int(dRnd * Cells(lRow, 2) / Cells(lRow, 1)))
Next iTrips[/COLOR][/SIZE][/FONT]

In this piece of code, the number of travels is divided by the number of trips to set a maximum limit for the initial number of each individual travels (20 / 3 = 6.667). This ensures no random number (initial value) goes beyond this limit.

Why this approach?

If we start with generating random by multiplying Rnd × Total number of travels (20), we might get 19 as a result. So, if 19 goes to one individual travel this leaves the remaining 1 travel to be shared between the other two travels, which is not possible. So, if we go this way then we have to do extensive checks to avoid such situation.

Therefore and for simplicity, the number of travels is divided by the number of trips to ensure balanced distribution of the initial random numbers.

[FONT=Consolas][SIZE=2][COLOR=Navy][COLOR=Green]'*
'* Apply correction factor, if need be[/COLOR]
iSum = Application.Sum(tbl)
If iSum <> Cells(lRow, 2) Then
    For iTrips = 1 To Cells(lRow, 1)
        tbl(iTrips) = Round(Cells(lRow, 2) / iSum * tbl(iTrips), 0)
    Next iTrips
End If[/COLOR][/SIZE][/FONT]

Suppose the result of generating the random numbers was; 3, 3 and 2. The sum is 8 which is less than the total of 20.

A correction factor is applied to adjust the initial numbers on a prorate basis using the formula,

Adjusted number = Total number of travels × Initial number / Sum of initial numbers

Accordingly, the numbers after adjustment are;
3 * 20 / 8 = 8
3 * 20 / 8 = 8
2 * 20 / 8 = 5

The total is 21, which is greater than 20. Therefore, further adjustment is required.

[FONT=Consolas][SIZE=2][COLOR=Navy][COLOR=Green]'*
'* If still some differences, distribute amongst tbl elements[/COLOR]
iSum = Application.Sum(tbl)
If iSum <> Cells(lRow, 2) Then
    For iTrips = 1 To Cells(lRow, 1)
        If iSum > Cells(lRow, 2) Then
            tbl(iTrips) = tbl(iTrips) - 1
            iSum = iSum - 1
        Else
            tbl(iTrips) = tbl(iTrips) + 1
            iSum = iSum + 1
        End If
        If iSum = Cells(lRow, 2) Then Exit For
    Next iTrips
End If[/COLOR][/SIZE][/FONT]

The last adjustment considers whether the sum of random numbers is greater than total travels (as in the example) or less (e.g.: initial numbers; 4, 4 and 3 »»» adjusted; 7, 7 and 5 = 19)

The approach is to distribute the remainder of subtracting total travels from the sum of random numbers amongst the generated numbers.

Back to the example, the remainder is 1, so it will be subtracted from the first number to get the final result; 7, 8 and 5 = 20.

Hope this is clear.

 

[abberyfarm]

Hello Mohammad,

Thank you very much for your effort to explain the code. It's much appreciated and of great help.

Best Regards

John

 

[Mohammad Basem]

Al-hamdullah, you're most welcome!
All the best