From 5a87acc87605662b0a1a453e0f374bfa1ba40f34 Mon Sep 17 00:00:00 2001 From: Paul Trowbridge Date: Wed, 20 Mar 2019 17:04:30 -0400 Subject: [PATCH] add function to setup for a new part on top of base scenario --- months.cls | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 94 insertions(+) diff --git a/months.cls b/months.cls index 904ccb0..2333b6c 100644 --- a/months.cls +++ b/months.cls @@ -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