Sub inv()
On Error GoTo ErrorHandler
'
'*** macro named: inv
'*** spreadsheet HonorsL.xlsm fall 2019
'
start_time = Time
num_itr = 5 '*** number of iterations
itr = 143 '*** start row for summary calculations of Lost Sales
itr_start = itr '*** remember where i started lost sales summary
oc_offset = num_itr + 4 '*** calculate where each cost summary will start
itr_oc_Start = itr_start + oc_offset
invcc_offset = oc_offset + num_itr + 3
itr_invcc_Start = itr_oc_Start + num_itr + 3
hold_offset = invcc_offset + num_itr + 5
itr_hold_Start = itr_invcc_Start + num_itr + 5
ending_itr = itr_hold_Start + num_itr + 7
For temp1 = itr To ending_itr
For temp2 = 1 To 12
Cells(temp1, temp2) = ""
Cells(temp1, temp2).Interior.Color = RGB(255, 255, 255)
Next
Next
Cells(itr, 1) = "LOST SALES"
Cells(itr, 1).Font.Bold = True
Cells(itr_oc_Start, 1) = "ORDERS COSTS"
Cells(itr_oc_Start, 1).Font.Bold = True
Cells(itr_invcc_Start, 1) = "INV. INTEREST COST"
Cells(itr_invcc_Start, 1).Font.Bold = True
Cells(itr_hold_Start, 1) = "HOLDING COSTS"
Cells(itr_hold_Start, 1).Font.Bold = True
ActiveWindow.DisplayGridlines = True
For itn = 1 To num_itr
Cells(140, 3) = "Iteration " + CStr(itn) + " of " + CStr(num_itr) + " initializing"
Cells(itr, 2) = "iter " + CStr(itn)
Cells(itr + oc_offset, 2) = "iter " + CStr(itn)
Cells(itr + invcc_offset, 2) = "iter " + CStr(itn)
Cells(itr + hold_offset, 2) = "iter " + CStr(itn)
table_start_date = "1/1/2003"
table_end_date = "12/31/2012"
ndays = DateDiff("d", table_start_date, table_end_date) '**** calculate the number of days in then inventory table
'
'set recvd=0, lost=0,onOrder=0 for all products all days, AND set initial colors
'
For i = 4 To (ndays + 4) '*** inventory table days start on the fourth row
For p = 1 To 9
startcol = 19 + (p - 1) * 10
Cells(i, startcol + 6) = 0
Cells(i, startcol + 8) = 0
Cells(i, startcol + 9) = 0
Cells(i, startcol + 4).Interior.Color = RGB(203, 203, 203)
Cells(i, startcol + 5).Interior.Color = RGB(203, 203, 203)
Cells(i, startcol + 6).Interior.Color = RGB(203, 203, 203)
Cells(i, startcol + 7).Interior.Color = RGB(203, 203, 203)
Cells(i, startcol + 8).Interior.Color = RGB(255, 255, 255)
Cells(i, startcol + 9).Interior.Color = RGB(255, 255, 255)
Next
Next
maxrows = ndays + 4
Dim inv(10) '***this in the inventory array for each product
For p = 1 To 9
inv(p) = Cells(3, p + 3) '*** copy the initial inventory values in row 3 starting in col 3 to the inv array
Next
'
'*** inventory orders for ALL products take from lag1 to lag2 DAYS as defined below
'
lag1 = 5
lag2 = 15
'
'******** Top of product, year, month and day loops
'
c = 19 '*** start column for first prod
cd = 4 '*** start column for demand table first product
For p = 1 To 9
Cells(140, 3) = "Iteration " + CStr(itn) + " of " + CStr(num_itr) + " Running Product " + CStr(p)
r = 4 '*** start row for each product in the inventory table (counts the days)
rd = 18 '*** start row for each product in the demand table (we start in 2003 not 2002)
this_date = "1/1/2003" '*** Start date for each products inventory table
osw = 0 '*** order swith, 0 means NO order is currently in place, 1 means an order HAS been placed
'
'*** inventory table cell locators:
' c=start column for the product -- ten values per product
' r=row for each day
'
'*** demand table cell locators
' cd = demand table column
' rd = demand table row
'
'
'*** zero lost sales total
'
Cells(itr, p + 2) = 0 '*** lost sales sum =0
Cells(itr, p + 2).Interior.Color = RGB(255, 0, 0)
Cells(itr + oc_offset, p + 2) = 0 '*** order costs sum =0
Cells(itr + oc_offset, p + 2).Interior.Color = RGB(127, 255, 127)
Cells(itr + invcc_offset, p + 2) = 0 '*** Inv interest costs sum=0
Cells(itr + invcc_offset, p + 2).Interior.Color = RGB(127, 127, 203)
Cells(itr + hold_offset, p + 2) = 0 '*** Holding costs sum =0
Cells(itr + hold_offset, p + 2).Interior.Color = RGB(203, 203, 127)
For y = 1 To 10 '*** ten year loop
this_year = Year(this_date)
For m = 1 To 12 '*** twelve month loop
ndays_this_month = Day(DateSerial(this_year, m + 1, 0))
For d = 1 To ndays_this_month
'*** Legend for each day (r) :
' Cell(r,c) = Monnthly Demand (Only in the row of the first day of each month, data in the Demand Table)
' Cell(r,c+1) = Monthly Order Quantity (Only in the row of the first day of each month, calculated)
' Cell(r,c+2) = Monthly ReOrder Point (Only in the row of the first day of each month, calculated)
' Cell(r,c+3) = Daily Demand (fixed for each day)
' Cell(r,c+4) = Daily Beginning Inventory
' Cell(r,c+5) = Daily Sales (based on Demand and availably inventory)
' Cell(r,c+6) = Daily Receipts (order amounts reveived)
' Cell(r,c+7) = Daily Ending Inventory (Beginning Inv - Sales + OrdersRecvd)
' Cell(r,c+8) = Daily Lost Sales (demand exceeds inventory)
' Cell(r,c+9) = Daily Units on order
If d = 1 Then '*** first day off the month, display:demand; order quantity; and reorderpt
Cells(r, c) = Cells(rd, cd) 'show monthly demand from the demand table in the inventory table
'************************************************************************************************
'* *
'* Make the inventory rules (determine: OrderQuantity & ReorderPoint) *
'* *
'************************************************************************************************
Cells(r, c + 1) = Cells(rd - 12, cd) * 1# '*** use last years demand as order quantity times a mutilpier
oq = Cells(r, c + 1) '*** store this month order quantity in the variable oq
'*** to change the value of last years's demand change the multiplier (1# means 1.0)
'
' change the 1# to 1.2, and the oq will be increased by 20%
' change the 1# to 1.1, and the oq will be increased by 10% ... etc
' leave 1# and the oq will be increased by 0%
' change the 1# to 0.9, and the oq will be decreased by 10%
' change the 1# to 0.8 and the oq will be increased by 20%
'
Cells(r, c + 2) = Cells(r, c + 1) * 0.5 '*** use 50% as a multiplier of last years demand as
' the reorder trigger
rop = CInt(Cells(r, c + 2)) '*** CINT means convert to an integer (truncates any fractional part)
' and store this month reorder point in the variable rop
'************************************************************************************************
'* *
'* End of Inventory Policy Rules *
'* *
'************************************************************************************************
End If
'
'*** DAILY make the inventory calculations
'
Cells(r, c + 4) = inv(p) '*** 1. display beginning inv
If Cells(r, c + 6) > 0 Then
inv(p) = inv(p) + Cells(r, c + 6) '*** 2. record receipts in the inventory
osw = 0 '*** turn off the on_order_switch
End If
'**** 3. now the sales and lost sales based on demand and available inventory
If Cells(r, c + 3) <= inv(p) Then '*** demand <= inventory, so remove ALL demand from inv
inv(p) = inv(p) - Cells(r, c + 3) '*** remove demand from inv
Cells(r, c + 5) = Cells(r, c + 3) '*** display sales=demand
Cells(r, c + 8) = 0 '*** show no demand lost
Else '*** demand > inv
Cells(r, c + 8) = Cells(r, c + 3) - inv(p) '*** calculate and show lost sales
Cells(r, c + 8).Interior.Color = RGB(255, 0, 0)
Cells(itr, p + 2) = Cells(itr, p + 2) + Cells(r, c + 8) '*** add lost sales to grand total
Cells(r, c + 5) = inv(p) '*** sell ALL the inventory (display sales)
inv(p) = 0 '*** show remaining inventory is zero
End If
Cells(r, c + 7) = inv(p) '*** display ending inv -- inv now contains ending inv
Cells(itr + hold_offset, p + 2) = Cells(itr + hold_offset, p + 2) + inv(p) '*** sum daily inv
'**** 4. time to reorder?
'
If inv(p) < rop And osw = 0 Then '*** place order if: inv < rop AND no order is pending
del_days = CInt(Rnd * (lag2 - lag1) + lag1) '*** calculate exact number of days to delivery
'*** show order pending for all these days
For tempr = r To (r + del_days)
If tempr <= maxrows Then
Cells(tempr, c + 9) = oq '***show oq units on order from now (r) to (r+del_days) days
Cells(tempr, c + 9).Interior.Color = RGB(255, 255, 0)
End If
Next
If (r + del_days + 1) <= maxrows Then
Cells((r + del_days + 1), c + 6) = oq '*** show recipt del_days in the future
Cells((r + del_days + 1), c + 6).Interior.Color = RGB(255, 255, 0)
End If
Cells(itr + oc_offset, p + 2) = Cells(itr + oc_offset, p + 2) + 1
Cells(itr + invcc_offset, p + 2) = Cells(itr + invcc_offset, p + 2) + oq
osw = 1 '*** turn on the on_order_switch
End If
'
'*** end of the daily tasks
'
this_date = CStr(DateAdd("d", 1, DateValue(this_date))) '*** set next date
r = r + 1 '*** move to the next day row
Next '*** end of day loop
rd = rd + 1 '*** next row (month) of demand table
Next '*** end of month loop
Next '*** end of year loop
c = c + 10 '*** move over ten columns to start of this product inventory table location
cd = cd + 1 '*** move over one column to start of this products monthly demand
ci = ci + 1 '*** move over one column to next initial inventory
Cells(itr + hold_offset, p + 2) = Cells(itr + hold_offset, p + 2) / ndays
Next '*** end of product loop
DoEvents
itr = itr + 1 '*** iteration output row
Next '***end Iteration loop (itn)
'
'*** make summary calculations
'
'
'*** lost sales summary
'
' new available row is itr
'
For p = 1 To 9
Cells(itr, 2 + p) = 0
For cols = itr_start To (itr_start + num_itr - 1)
Cells(itr, 2 + p) = Cells(itr, 2 + p) + Cells(cols, 2 + p)
Next
Next
For p = 1 To 9
Cells(itr, 2 + p) = Cells(itr, 2 + p) / num_itr
Next
Cells(itr, 1) = "Average Lost Sales"
Range(Cells(itr, 3), Cells(itr, 11)).NumberFormat = "##0.0"
'
'*** place the lost gross margins in the next row
'
itr = itr + 1
Cells(itr, 3) = 60#
Cells(itr, 4) = 50#
Cells(itr, 5) = 220#
Cells(itr, 6) = 265#
Cells(itr, 7) = 50#
Cells(itr, 8) = 70
Cells(itr, 9) = 150#
Cells(itr, 10) = 5#
Cells(itr, 11) = 4#
Cells(itr, 1) = "Lost Unit Gross Margin"
Range(Cells(itr, 3), Cells(itr, 11)).NumberFormat = "##0.00"
'
'*** multiply and make the row total
'
itr = itr + 1
Cells(itr, 12) = 0
For p = 1 To 9
Cells(itr, p + 2) = Cells(itr - 1, p + 2) * Cells(itr - 2, p + 2)
Cells(itr, 12) = Cells(itr, 12) + Cells(itr, p + 2)
Next
Cells(itr, 1) = "Ave Opp. Costs"
Range(Cells(itr, 3), Cells(itr, 12)).NumberFormat = "###,##0"
Cells(itr, 12).Font.Bold = True
'
'*** order costs
'
For p = 1 To 9
Cells(itr_oc_Start + num_itr, 2 + p) = 0
For cols = itr_oc_Start To (itr_oc_Start + num_itr - 1)
Cells(itr_oc_Start + num_itr, 2 + p) = Cells(itr_oc_Start + num_itr, 2 + p) + Cells(cols, 2 + p)
Next
Cells(itr_oc_Start + num_itr, 2 + p) = Cells(itr_oc_Start + num_itr, 2 + p) / num_itr
Next
Cells(itr_oc_Start + num_itr, 1) = "Ave Orders"
Range(Cells(itr_oc_Start + num_itr, 3), Cells(itr_oc_Start + num_itr, 11)).NumberFormat = "##0.0"
Cells(itr_oc_Start + num_itr + 1, 1) = "Ave Order Cost"
Range(Cells(itr_oc_Start + num_itr + 1, 3), Cells(itr_oc_Start + num_itr + 1, 11)).NumberFormat = "###,##0"
Cells(itr_oc_Start + num_itr + 1, 12) = 0
'
' ****** order costs below
'
For p = 1 To 9
Cells(itr_oc_Start + num_itr + 1, p + 2) = Cells(itr_oc_Start + num_itr, p + 2) * 233# '**** this line ends in order cost
Cells(itr_oc_Start + num_itr + 1, 12) = Cells(itr_oc_Start + num_itr + 1, 12) + Cells(itr_oc_Start + num_itr + 1, p + 2)
Next
Cells(itr_oc_Start + num_itr + 1, 12).Font.Bold = True
'
'*** Inv Interest Carrying Costs
'
itr = itr_invcc_Start
For p = 1 To 9
Cells(itr_invcc_Start + num_itr, p + 2) = 0
For cols = itr_invcc_Start To (itr_invcc_Start + num_itr - 1)
Cells(itr_invcc_Start + num_itr, p + 2) = Cells(itr_invcc_Start + num_itr, p + 2) + Cells(cols, p + 2)
Next
Cells(itr_invcc_Start + num_itr, 2 + p) = Cells(itr_invcc_Start + num_itr, 2 + p) / num_itr
Next
Cells(itr_invcc_Start + num_itr, 1) = "Ave. 10 Yr Quant. Ordered"
Range(Cells(itr_invcc_Start + num_itr, 3), Cells(itr_invcc_Start + num_itr, 11)).NumberFormat = "###,##0.0"
Range(Cells(itr_invcc_Start + num_itr + 1, 3), Cells(itr_invcc_Start + num_itr + 1, 11)).NumberFormat = "##0.00"
Range(Cells(itr_invcc_Start + num_itr + 2, 3), Cells(itr_invcc_Start + num_itr + 2, 11)).NumberFormat = "##,###,##0"
Range(Cells(itr_invcc_Start + num_itr + 3, 3), Cells(itr_invcc_Start + num_itr + 3, 12)).NumberFormat = "###,##0"
Cells(itr_invcc_Start + num_itr + 3, 12).Font.Bold = True
Cells(itr_invcc_Start + num_itr + 1, 1) = "$ Unit Cost"
Cells(itr_invcc_Start + num_itr + 1, 3) = 95.99
Cells(itr_invcc_Start + num_itr + 1, 4) = 81#
Cells(itr_invcc_Start + num_itr + 1, 5) = 39#
Cells(itr_invcc_Start + num_itr + 1, 6) = 215#
Cells(itr_invcc_Start + num_itr + 1, 7) = 35#
Cells(itr_invcc_Start + num_itr + 1, 8) = 49.25
Cells(itr_invcc_Start + num_itr + 1, 9) = 209#
Cells(itr_invcc_Start + num_itr + 1, 10) = 12.99
Cells(itr_invcc_Start + num_itr + 1, 11) = 7.99
Cells(itr_invcc_Start + num_itr + 2, 1) = "Ave. $ Cost of Orders"
For p = 1 To 9
Cells(itr_invcc_Start + num_itr + 2, p + 2) = Cells(itr_invcc_Start + num_itr + 1, p + 2) * Cells(itr_invcc_Start + num_itr, p + 2)
Next
Cells(itr_invcc_Start + num_itr + 3, 1) = "Ave. 10 Yr Int Cost"
Cells(itr_invcc_Start + num_itr + 3, 12) = 0
For p = 1 To 9
Cells(itr_invcc_Start + num_itr + 3, p + 2) = Cells(itr_invcc_Start + num_itr + 2, p + 2) * 0.14 / 12#
Cells(itr_invcc_Start + num_itr + 3, 12) = Cells(itr_invcc_Start + num_itr + 3, 12) + Cells(itr_invcc_Start + num_itr + 3, p + 2)
Next
'
' *** Holding Costs
'
itr = itr_hold_Start
For p = 1 To 9
Cells(itr_hold_Start + num_itr, p + 2) = 0
For cols = itr_hold_Start To (itr_hold_Start + num_itr - 1)
Cells(itr_hold_Start + num_itr, p + 2) = Cells(itr_hold_Start + num_itr, p + 2) + Cells(cols, p + 2)
Next
Cells(itr_hold_Start + num_itr, 2 + p) = Cells(itr_hold_Start + num_itr, 2 + p) / num_itr
Next
Cells(itr_hold_Start + num_itr, 1) = "Ave. 10 Yr Daily Inv."
Range(Cells(itr_hold_Start + num_itr, 3), Cells(itr_hold_Start + num_itr, 11)).NumberFormat = "##0.0"
Cells(itr_hold_Start + num_itr + 1, 1) = "$ Unit Cost"
Cells(itr_hold_Start + num_itr + 1, 3) = 95.99
Cells(itr_hold_Start + num_itr + 1, 4) = 81#
Cells(itr_hold_Start + num_itr + 1, 5) = 39#
Cells(itr_hold_Start + num_itr + 1, 6) = 215#
Cells(itr_hold_Start + num_itr + 1, 7) = 35#
Cells(itr_hold_Start + num_itr + 1, 8) = 49.25
Cells(itr_hold_Start + num_itr + 1, 9) = 209#
Cells(itr_hold_Start + num_itr + 1, 10) = 12.99
Cells(itr_hold_Start + num_itr + 1, 11) = 7.99
Range(Cells(itr_hold_Start + num_itr + 1, 3), Cells(itr_hold_Start + num_itr + 1, 11)).NumberFormat = "##0.00"
Cells(itr_hold_Start + num_itr + 2, 1) = "Ave. 10 Yr. Daily Value"
Range(Cells(itr_hold_Start + num_itr + 2, 3), Cells(itr_hold_Start + num_itr + 2, 11)).NumberFormat = "###,##0.00"
For p = 1 To 9
Cells(itr_hold_Start + num_itr + 2, p + 2) = Cells(itr_hold_Start + num_itr + 1, p + 2) * Cells(itr_hold_Start + num_itr, p + 2)
Next
Range(Cells(itr_hold_Start + num_itr + 3, 3), Cells(itr_hold_Start + num_itr + 3, 12)).NumberFormat = "###,##0"
Cells(itr_hold_Start + num_itr + 3, 12).Font.Bold = True
Cells(itr_hold_Start + num_itr + 3, 1) = "Total Holding Costs"
Cells(itr_hold_Start + num_itr + 3, 12) = 0
For p = 1 To 9
Cells(itr_hold_Start + num_itr + 3, p + 2) = Cells(itr_hold_Start + num_itr + 2, p + 2) * 0.73
Cells(itr_hold_Start + num_itr + 3, 12) = Cells(itr_hold_Start + num_itr + 3, 12) + Cells(itr_hold_Start + num_itr + 3, p + 2)
Next
Cells(itr_hold_Start + num_itr + 5, 12).NumberFormat = "###,##0"
Cells(itr_hold_Start + num_itr + 5, 12) = Cells(itr_start + num_itr + 2, 12) + Cells(itr_oc_Start + num_itr + 1, 12) + Cells(itr_invcc_Start + num_itr + 3, 12) + Cells(itr_hold_Start + num_itr + 3, 12)
Cells(itr_hold_Start + num_itr + 5, 12).Font.Bold = True
Cells(itr_hold_Start + num_itr + 5, 9) = "Total Inventory Costs"
Cells(itr_hold_Start + num_itr + 5, 9).Font.Bold = True
end_time = Time
Cells(itr_hold_Start + num_itr + 6, 3) = Format(end_time - start_time, "mm:ss;@")
Cells(itr_hold_Start + num_itr + 6, 1) = "Elapsed execution time (mins:secs)"
Cells(140, 3) = "All Iterations Completed OK"
Exit Sub
ErrorHandler:
MsgBox Err.Number & ": " & Error.Description
Exit Sub
End Sub