VBA List Data

hshone

New Member
Joined
Feb 23, 2015
Messages
12
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 :

Code:
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.
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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

Code:
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
 
Upvote 0
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.

Code:
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
 
Upvote 0
Another option:-
Data in columns "A & B", Results in columns "D & E".
Code:
[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
 
Upvote 0

Forum statistics

Threads
1,213,514
Messages
6,114,078
Members
448,547
Latest member
arndtea

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top