add function to setup for a new part on top of base scenario

This commit is contained in:
Paul Trowbridge 2019-03-20 17:04:30 -04:00
parent 90caea49f6
commit 5a87acc876

View File

@ -777,3 +777,97 @@ Sub build_new()
dumping = False
End Sub
Sub new_part()
'keep customer mix
'add in new part number
'retain to _month
'set new part flag
Dim cust() As String
Dim b() As Variant
Dim i As Long
'---------build customer mix-------------------------------------------------------------------
cust = x.SHTp_Get("_month", 1, 27, True)
If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
MsgBox ("error building customer mix")
End If
'--------inquire for new part to join with cust mix--------------------------------------------
part.Show
dumping = True
Worksheets("month").Range("B33:Q10000").ClearContents
For i = 1 To UBound(cust, 2)
Sheets("month").Cells(32 + i, 2) = part.cbPart.value
Sheets("month").Cells(32 + i, 6) = cust(0, i)
Sheets("month").Cells(32 + i, 12) = cust(1, i)
Sheets("month").Cells(32 + i, 17) = CDbl(cust(2, i))
Next i
Sheets("config").Cells(7, 2) = 1
'------copy revised basket to _month storage---------------------------------------------------
i = 0
Do Until Worksheets("month").Cells(33 + i, 2) = ""
i = i + 1
Loop
i = i - 1
ReDim b(i, 3)
i = 0
Do Until Worksheets("month").Cells(33 + i, 2) = ""
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
If b(i, 3) = "" Then b(i, 3) = 0
i = i + 1
Loop
Worksheets("_month").Range("U2:AC10000").ClearContents
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
'------reset volume to copy base to forecsat and clear base------------------------------------
units = Sheets("_month").Range("A2:E13").FormulaR1C1
price = Sheets("_month").Range("F2:J13").FormulaR1C1
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
tunits = Range("B18:F18")
tprice = Range("H18:L18")
tsales = Range("N18:R18")
ReDim adjust(12)
Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
For i = 1 To 12
'volume
units(i, 5) = units(i, 2)
units(i, 4) = units(i, 2)
units(i, 1) = 0
units(i, 2) = 0
units(i, 3) = 0
'sales
sales(i, 5) = sales(i, 2)
sales(i, 4) = sales(i, 2)
sales(i, 1) = 0
sales(i, 2) = 0
sales(i, 3) = 0
'price
price(i, 5) = price(i, 2)
price(i, 4) = price(i, 2)
price(i, 1) = 0
price(i, 2) = 0
price(i, 3) = 0
Call Me.build_json(i)
Next i
Call Me.crunch_array
Call Me.set_sheet
dumping = False
End Sub