# VBA List Data

#### hshone

##### New Member
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.

#### Steve_

##### Board Regular
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``````

#### hshone

##### New Member
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``````

#### MickG

##### MrExcel MVP
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

#### Steve_

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

#### hshone

##### New Member
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.