VBA List Data

[hshone]

Hi all,

I have a list of data:

Apple 580
Pear 245
Orange 867
Cherry 870
etc.

What I want to do is split my inventory between 5 locations randomly, but will only ever total the total inventory and then have VBA print the array so that it's like the following:

Apple 156
Apple 142
Apple 52
Apple 68
Apple 162
etc.

I have done this in excel, but very manual generating 5 random numbers then divide the random number by the Sum of 5 random numbers so that I get 100% the multiplying each % by the total number of apples and so on.

Excel Formula:

=(RANDOM NUMBER/SUM(RANDOM NUMBERS 1-5))*Inventory

To avoid all the decimals I'm rounding the numbers and row 5 is the total inventory - sum of 4 so that I wont have +-1 either side due to decimals

I have the following snippet to make the random numbers :

Sub Number()

   Dim RandomNumber1 As Integer
   Dim RandomNumber2 As Integer
   Dim RandomNumber3 As Integer
   Dim RandomNumber4 As Integer
   
   Randomize
   LRandomNumber1 = Int((100 - 0 + 1) * Rnd + 0)
   LRandomNumber2 = Int((100 - 0 + 1) * Rnd + 0)
   LRandomNumber3 = Int((100 - 0 + 1) * Rnd + 0)
   LRandomNumber4 = Int((100 - 0 + 1) * Rnd + 0)
   
End Sub

Anybody got an hints how I should approach this, I would presume some kind of array with loops i.e. row 1 calculate row 5 inventory then row 2 etc. and then print all the values to a new sheet.

 

[Steve_]

Hi all,

I have a list of data:

Apple 580
Pear 245
Orange 867
Cherry 870
etc.

What I want to do is split my inventory between 5 locations randomly, but will only ever total the total inventory and then have VBA print the array so that it's like the following:

Apple 156
Apple 142
Apple 52
Apple 68
Apple 162
etc.

I have done this in excel, but very manual generating 5 random numbers then divide the random number by the Sum of 5 random numbers so that I get 100% the multiplying each % by the total number of apples and so on.

Excel Formula:

=(RANDOM NUMBER/SUM(RANDOM NUMBERS 1-5))*Inventory

To avoid all the decimals I'm rounding the numbers and row 5 is the total inventory - sum of 4 so that I wont have +-1 either side due to decimals

I have the following snippet to make the random numbers :


Anybody got an hints how I should approach this, I would presume some kind of array with loops i.e. row 1 calculate row 5 inventory then row 2 etc. and then print all the values to a new sheet.

Not sure if this is right..but it should be a good start

Sub Test()
    Dim invArray(3, 6)
    invArray(0, 0) = "Apple": invArray(0, 1) = 580
    invArray(1, 0) = "Pear": invArray(1, 1) = 245
    invArray(2, 0) = "Orange": invArray(2, 1) = 867
    invArray(3, 0) = "Cherry": invArray(3, 1) = 870
    For x = LBound(invArray, 1) To UBound(invArray, 1)
        curInv = invArray(x, 1)
        For y = LBound(invArray, 2) + 2 To UBound(invArray, 2)
            Randomize Timer
            invArray(x, y) = CInt(Rnd * ((curInv - 1)) * 0.75) + 1
            curInv = curInv - invArray(x, y)
            If y = UBound(invArray, 2) Then
                invArray(x, y) = invArray(x, y) + curInv
            End If
        Next y
    Next x
    Range(Cells(1, 1), Cells(UBound(invArray, 1) + 1, UBound(invArray, 2) + 1)) = invArray
End Sub

 

[hshone]

Thanks;

This is what i have so far, but its a little clunky and keeps referring too/ recalc excel cells, Ideally want to keep the random numbers the same to speed it up a little hence using Integers with the random numbers.

Dim h As Integer, i As Integer, j As Integer, k As Integer, last_row As Integer, MyArray() As Variant, l As Integer


last_row = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row


ReDim MyArray(5 * (last_row - 1), 2)


For h = 0 To last_row - 2
        For i = 4 To 8
            Worksheets(2).Cells(5, i).Value = Int((100 - 0 + 1) * Rnd + 0)
        Next i


        For j = 4 To 8
            Worksheets(2).Cells(6, j).Value = Worksheets(2).Cells(5, j).Value / Application.WorksheetFunction.Sum(Worksheets(2).Range("D5:H5").Value)
        Next j


        For k = 4 To 7
            Worksheets(2).Cells(4, k).Value = "=Round(" & Worksheets(2).Cells(6, k).Value & "*" & Worksheets(2).Cells(h + 2, 2).Value & ", 0)"
        Next k


        Worksheets(2).Cells(4, 8).Value = Application.WorksheetFunction.Round(Worksheets(2).Cells(h + 2, 2).Value - Application.WorksheetFunction.Sum(Worksheets(2).Range("D4:G4")), 0)
    
        For l = 1 To 5
            MyArray(l + (5 * h), 1) = Worksheets(2).Cells(h + 2, 1).Value
            MyArray(l + (5 * h), 2) = Worksheets(2).Cells(4, l + 3).Value
        Next l
Next h


Worksheets(2).Cells(10, 10).Resize(5 * (last_row - 1), 2).Value = MyArray

 

[MickG]

Another option:-
Data in columns "A & B", Results in columns "D & E".

[COLOR="Navy"]Sub[/COLOR] MG22Jul42
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oSum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] s [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    oSum = Dn.Offset(, 1).Value
    s = 0
    [COLOR="Navy"]For[/COLOR] n = 1 To 5
        c = c + 1
        Cells(c, 4) = Dn.Value
        [COLOR="Navy"]If[/COLOR] n < 5 [COLOR="Navy"]Then[/COLOR]
            R = Application.RandBetween(1, 50) / 100 * oSum
        [COLOR="Navy"]Else[/COLOR]
            R = Dn.Offset(, 1).Value - s
        [COLOR="Navy"]End[/COLOR] If
            Cells(c, 5) = R
            s = s + R
            oSum = oSum - R
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Steve_]

Did my code not work for you? Was there an error? I can likely fix it.

 

[hshone]

Did my code not work for you? Was there an error? I can likely fix it.

Yes it did work, but spat the results over columns not rows.