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.
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Steve_

Board Regular
Joined
Apr 28, 2010
Messages
167
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
Joined
Feb 23, 2015
Messages
12
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
Joined
Jan 9, 2008
Messages
14,841
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
Joined
Apr 28, 2010
Messages
167
Did my code not work for you? Was there an error? I can likely fix it.
 

Watch MrExcel Video

Forum statistics

Threads
1,089,766
Messages
5,410,303
Members
403,309
Latest member
chaithra

This Week's Hot Topics

Top