VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt Caption = "Forecast Adjustment" ClientHeight = 8445.001 ClientLeft = 120 ClientTop = 465 ClientWidth = 8805.001 OleObjectBlob = "fpvt.frx":0000 StartUpPosition = 1 'CenterOwner End Attribute VB_Name = "fpvt" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public mod_adjust As Boolean Private month() As Variant Private mload() As Variant Private adjust As Object Private nomonth As Boolean Private mline As Integer Private clear_lb As Boolean Private load_tb As Boolean Private set_Price As Boolean Private sp As Object Private basket() As Variant Private cust() As Variant Private vSwap() As Variant Private swapline As Integer Private set_swapalt As Boolean Private return_swap As Boolean Private jswap As Object Private cswap As Object Private cust_s() As Boolean Private bVol As Double Private bVal As Double Private bPrc As Double Private pVol As Double Private pVal As Double Private pPrc As Double Private aVol As Double Private aVal As Double Private aPrc As Double Private fVol As Double Private fVal As Double Private fPrc As Double Private bVolm As Double Private bValm As Double Private bPrcm As Double Private pVolm As Double Private pValm As Double Private pPrcm As Double Private aVolm As Double Private aValm As Double Private aPrcm As Double Private fVolm As Double Private fValm As Double Private fPrcm As Double Option Explicit Private Sub cbCancel_Click() tbAdjVol.value = 0 tbAdjVal.value = 0 tbAdjPrice.value = 0 fpvt.Hide End Sub Private Sub butAdjust_Click() Dim fail As Boolean Dim doc As String If tbAPI.text = "" Then MsgBox ("No adjustments provided") Exit Sub End If If cbTAG.text = "" Then MsgBox ("no tag was selected") Exit Sub End If Select Case fpvt.mp.SelectedItem.Name Case "pageSWAP" doc = tbAPI.text If doc = "" Then MsgBox ("no part swap setup") Exit Sub End If Case "pAnn" doc = tbAPI.text If doc = "" Then MsgBox ("no adjustements are ready") Exit Sub End If Case Else doc = tbAPI.text 'MsgBox ("not on an adjustable tab") 'Exit Sub End Select Call handler.request_adjust(doc, fail) If fail Then MsgBox ("adjustment was not made due to error") Exit Sub End If Me.tbCOM = "" Me.cbTAG.text = "" Me.Hide Set adjust = Nothing End Sub Private Sub butCancel_Click() Me.Hide End Sub Private Sub butMAdjust_Click() Dim i As Integer For i = 1 To 12 If month(i, 10) <> "" Then Call handler.request_adjust(CStr(month(i, 10))) End If Next i Me.Hide End Sub Private Sub butMCancel_Click() Me.Hide End Sub Private Sub cbGoSheet_Click() Worksheets("month").tbMCOM.text = "" Worksheets("month").sbMPV.value = 0 Worksheets("month").sbMPP.value = 0 Me.Hide months.cbMTAG.value = "" Worksheets("month").Visible = xlSheetVisible Sheets("month").Select End Sub Private Sub cbTAG_Change() Dim j As Object If tbAPI.text = "" Then tbAPI.text = "{}" Set j = JsonConverter.ParseJson(tbAPI.text) j("tag") = cbTAG.value tbAPI.text = JsonConverter.ConvertToJson(j) End Sub Private Sub lbMonth_Change() If clear_lb Or load_tb Then Exit Sub Dim i As Long For i = 0 To 13 If lbMonth.Selected(i) Then mline = i If i <> 0 And i <> 13 Then Me.load_var Me.load_mbox Else load_tb = True tbMBaseVal.value = "" tbMBaseVol.value = "" tbMBasePrice.value = "" tbmPAVal.value = "" tbMPAVol.value = "" tbMPAPrice.value = "" tbMFVal.value = "" tbMFVol.value = "" tbMFPrice.value = "" tbMAVal.value = "" tbMAVol.value = "" tbMAPrice.value = "" load_tb = False End If Exit For End If Next i End Sub Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode <> 13 Then Exit Sub Dim i As Long If set_swapalt Then Exit Sub Dim vtable() As Variant Dim ptable As String Dim rx As Object Set rx = CreateObject("vbscript.regexp") rx.Global = True rx.Pattern = " - .*" For i = 0 To Me.lbSWAP.ListCount - 1 If Me.lbSWAP.Selected(i) Then vSwap(swapline, 2) = rx.Replace(cbPLIST.value, "") return_swap = True lbSWAP.list = vSwap return_swap = False End If Next i vtable = x.ARRAYp_TransposeVar(vSwap) vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit") vtable = x.ARRAYp_TransposeVar(vtable) ptable = x.json_from_table_zb(vtable, "rows", True, False) Set jswap("swap") = JsonConverter.ParseJson(ptable) jswap("scenario")("version") = handler.plan jswap("scenario")("iter") = handler.basis jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") jswap("user") = Application.UserName jswap("source") = "adj" jswap("message") = tbCOM.text jswap("tag") = cbTAG.text jswap("type") = "swap" tbAPI.text = JsonConverter.ConvertToJson(jswap) End Sub Private Sub dbGETSWAP_Click() Dim doc As String Dim j As Object Dim fail As Boolean Dim l() As Variant Dim ptable As String Dim vtable() As Variant Set j = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}") 'Set j = JsonConverter.ParseJson(doc) j("new_mold") = pickSWAP.text doc = JsonConverter.ConvertToJson(j) vSwap = handler.get_swap_fit(doc, fail) lbSWAP.list = vSwap 'Call x.frmListBoxHeader(lbSWAPH, lbSWAP, "Original", "Sales", "Replacement", "Fit") cbPLIST.list = Application.transpose(Worksheets("mdata").Range("A2:A26267")) '---------build change------------- Set jswap = j vtable = x.ARRAYp_TransposeVar(vSwap) vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit") vtable = x.ARRAYp_TransposeVar(vtable) ptable = x.json_from_table_zb(vtable, "rows", True, False) Set jswap("swap") = JsonConverter.ParseJson(ptable) jswap("scenario")("version") = handler.plan jswap("scenario")("iter") = handler.basis jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") jswap("user") = Application.UserName jswap("source") = "adj" jswap("message") = tbCOM.text jswap("tag") = cbTAG.text jswap("type") = "swap" tbAPI.text = JsonConverter.ConvertToJson(jswap) End Sub Private Sub lbSWAP_Change() Dim i As Long If return_swap Then Exit Sub For i = 0 To Me.lbSWAP.ListCount - 1 If Me.lbSWAP.Selected(i) Then set_swapalt = True cbPLIST.value = vSwap(i, 2) set_swapalt = False swapline = i End If Next i End Sub Private Sub lbSWAP_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ' Dim rx As Object ' Set rx = CreateObject("vbscript.regexp") ' rx.Global = True ' rx.Pattern = " - .*" ' Dim match As Object ' Dim i As Long ' Dim v As Variant ' ' 'v = Me.lbSWAP.list ' ' For i = 0 To Me.lbSWAP.ListCount - 1 ' If Me.lbSWAP.Selected(i) Then ' part.Show ' If Not part.useval Then ' Exit Sub ' End If ' 'vSwap(i, 3) = rx.Execute(part.cbPart.value) ' 'v(i, 2) = rx.Replace(part.cbPart.value, "") ' 'Me.lbSWAP.list = v ' End If ' Next i ' End Sub Private Sub opEditPrice_Click() opPlugVol.Enabled = False opPlugPrice.Enabled = False opPlugVol.Visible = False opPlugPrice.Visible = False opPlugPrice.value = True opPlugVol.value = False tbFcPrice.Enabled = True tbFcPrice.BackColor = &H80000018 tbFcVal.Enabled = False tbFcVal.BackColor = &H80000005 tbFcVol.Enabled = True tbFcVol.BackColor = &H80000018 sbpv.Enabled = True sbpp.Enabled = True sbpd.Enabled = False tbpv.Enabled = True tbpp.Enabled = True tbpd.Enabled = False End Sub Private Sub opEditSales_Click() opPlugVol.Enabled = True opPlugPrice.Enabled = True opPlugVol.Visible = True opPlugPrice.Visible = True tbFcPrice.Enabled = False tbFcPrice.BackColor = &H80000005 tbFcVal.Enabled = True tbFcVal.BackColor = &H80000018 tbFcVol.Enabled = False tbFcVol.BackColor = &H80000005 sbpv.Enabled = False sbpp.Enabled = False sbpd.Enabled = True tbpv.Enabled = False tbpp.Enabled = False tbpd.Enabled = True End Sub Private Sub opEditPriceM_Click() opmvol.Enabled = False opmprice.Enabled = False opmvol.Visible = False opmprice.Visible = False opmprice.value = True opmvol.value = True tbMFPrice.Enabled = True tbMFPrice.BackColor = &H80000018 tbMFVal.Enabled = False tbMFVal.BackColor = &H80000005 tbMFVol.Enabled = True tbMFVol.BackColor = &H80000018 End Sub Private Sub opEditSalesM_Click() opmvol.Enabled = True opmprice.Enabled = True opmvol.Visible = True opmprice.Visible = True tbMFPrice.Enabled = False tbMFPrice.BackColor = &H80000005 tbMFVal.Enabled = True tbMFVal.BackColor = &H80000018 tbMFVol.Enabled = False tbMFVol.BackColor = &H80000005 End Sub Private Sub opEditVolM_Click() opmvol.Enabled = False opmprice.Enabled = False opmprice.value = False opmvol.value = True opmvol.Enabled = False opmprice.Enabled = False opmvol.Visible = False opmprice.Visible = False tbMFPrice.Enabled = False tbMFPrice.BackColor = &H80000005 tbMFVal.Enabled = False tbMFVal.BackColor = &H80000005 tbMFVol.Enabled = True tbMFVol.BackColor = &H80000018 End Sub Private Sub opPlugPrice_Click() calc_val If opPlugPrice.value = True Then opPlugPrice.BackColor = -2147483624 Else opPlugPrice.BackColor = -2147483644 End If If opPlugVol.value = True Then opPlugVol.BackColor = -2147483624 Else opPlugVol.BackColor = -2147483644 End If End Sub Private Sub opPlugVol_Click() calc_val If opPlugVol.value = True Then opPlugVol.BackColor = -2147483624 Else opPlugVol.BackColor = -2147483644 End If If opPlugPrice.value = True Then opPlugPrice.BackColor = -2147483624 Else opPlugPrice.BackColor = -2147483644 End If End Sub Private Sub pickSWAP_Change() End Sub Private Sub sbpd_Change() tbpd.value = sbpd.value End Sub Private Sub sbpp_Change() tbpp.value = sbpp.value End Sub Private Sub sbpv_Change() tbpv.value = sbpv.value End Sub Private Sub tbCOM_Change() If tbAPI.text = "" Then tbAPI.text = "{}" Set adjust = JsonConverter.ParseJson(tbAPI.text) adjust("message") = tbCOM.text tbAPI.text = JsonConverter.ConvertToJson(adjust) End Sub Private Sub tbFcPrice_Change() If load_tb Then Exit Sub set_Price = True If opEditPrice Then calc_price set_Price = False End Sub Private Sub tbFcVal_Change() If load_tb Then Exit Sub If opEditSales Then calc_val End Sub Private Sub tbFcVol_Change() If load_tb Then Exit Sub If opEditPrice Then calc_price End Sub '--------------------------------monthly buttons-------------------------------------- Private Sub opmPrice_Click() calc_mval End Sub Private Sub opmVol_Click() calc_mval End Sub Private Sub tbmfPrice_Change() If mline = 0 Then Exit Sub If clear_lb Or load_tb Then Exit Sub set_Price = True If opEditPriceM Then calc_mprice set_Price = False End Sub Private Sub tbMFVal_Change() If mline = 0 Then Exit Sub If clear_lb Or load_tb Then Exit Sub If opEditSalesM Then calc_mval End Sub Private Sub tbmfVol_Change() If mline = 0 Then Exit Sub If clear_lb Or load_tb Then Exit Sub If opEditPriceM Then calc_mprice End Sub Private Sub tbpd_Change() If load_tb Then Exit Sub If Not VBA.IsNumeric(tbpd.value) Then tbpd = "0" End If tbFcVal = (bVal + pVal) * (1 + tbpd.value / 100) End Sub Private Sub tbpp_Change() If load_tb Then Exit Sub If Not VBA.IsNumeric(tbpd.value) Then tbpd = "0" End If tbFcPrice = (bPrc + pPrc) * (1 + tbpp.value / 100) Me.load_mbox_ann End Sub Private Sub tbpv_Change() If load_tb Then Exit Sub If Not VBA.IsNumeric(tbpv.value) Then tbpd = "0" End If tbFcVol = (bVol + pVol) * (1 + tbpv.value / 100) End Sub Private Sub UserForm_Activate() Dim i As Long Dim j As Long Dim k As Long Dim ok As Boolean Dim tags() As Variant Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2) Me.mp.Visible = False Me.lheader = "Loading..." Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok) Call x.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection") Me.lheader = "Ready" If Not ok Then fpvt.Hide Application.StatusBar = False Exit Sub End If '---show existing adjustment if there is one---- fpvt.mod_adjust = False pVol = 0 pVal = 0 pPrc = 0 bVol = 0 bVal = 0 bPrc = 0 aVol = 0 aVal = 0 aPrc = 0 fVal = 0 fVol = 0 fPrc = 0 Me.tbAPI.value = "" If IsNull(sp("package")("totals")) Then fpvt.Hide Application.StatusBar = False Exit Sub End If For i = 1 To sp("package")("totals").Count Select Case sp("package")("totals")(i)("order_season") Case 2021 Select Case Me.iter_def(sp("package")("totals")(i)("iter")) Case "baseline" bVol = bVol + sp("package")("totals")(i)("units") bVal = bVal + sp("package")("totals")(i)("value_usd") If bVol <> 0 Then bPrc = bVal / bVol Case "adjust" pVol = pVol + sp("package")("totals")(i)("units") pVal = pVal + sp("package")("totals")(i)("value_usd") Case "exclude" End Select End Select Next i fVol = bVol + pVol fVal = bVal + pVal If fVol = 0 Then fPrc = 0 Else fPrc = fVal / fVol End If If (bVol + pVol) = 0 Then pPrc = 0 Else If bVol = 0 Then pPrc = 0 Else pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol End If End If If aVal <> 0 Then MsgBox (aVal) End If Me.load_mbox_ann '---------------------------------------populate monthly------------------------------------------------------- k = 0 '--parse json into variant array for loading-- ReDim month(sp("package")("mpvt").Count + 1, 10) For i = 1 To sp("package")("mpvt").Count month(i, 0) = sp("package")("mpvt")(i)("order_month") month(i, 1) = sp("package")("mpvt")(i)("2020 qty") month(i, 2) = sp("package")("mpvt")(i)("2021 base qty") month(i, 3) = sp("package")("mpvt")(i)("2021 adj qty") month(i, 4) = sp("package")("mpvt")(i)("2021 tot qty") month(i, 5) = sp("package")("mpvt")(i)("2020 value_usd") month(i, 6) = sp("package")("mpvt")(i)("2021 base value_usd") month(i, 7) = sp("package")("mpvt")(i)("2021 adj value_usd") month(i, 8) = sp("package")("mpvt")(i)("2021 tot value_usd") If co_num(month(i, 2), 0) = 0 Then month(i, 9) = "addmonth" Else month(i, 9) = "scale" End If Next i month(0, 0) = "month" month(13, 0) = "total" month(0, 1) = "2020 qty" month(0, 2) = "2021 base qty" month(0, 3) = "2021 adj qty" month(0, 4) = "2021 qty" month(0, 5) = "2020 val" month(0, 6) = "2021 base val" month(0, 7) = "2021 adj val" month(0, 8) = "2021 val" Me.crunch_array ReDim basket(sp("package")("basket").Count, 3) ' basket(0, 0) = "order_season" ' basket(0, 1) = "order_month" ' basket(0, 2) = "version" ' basket(0, 3) = "iter" ' basket(0, 4) = "part_descr" ' basket(0, 5) = "bill_cust_descr" ' basket(0, 6) = "ship_cust_descr" ' basket(0, 7) = "units" ' basket(0, 8) = "value_usd" basket(0, 0) = "part_descr" basket(0, 1) = "bill_cust_descr" basket(0, 2) = "ship_cust_descr" basket(0, 3) = "mix" For i = 1 To UBound(basket, 1) 'basket(i, 0) = sp("package")("base")(i)("order_season") 'basket(i, 1) = sp("package")("base")(i)("order_month") 'basket(i, 2) = sp("package")("base")(i)("version") 'basket(i, 3) = sp("package")("base")(i)("iter") 'basket(i, 4) = sp("package")("base")(i)("part_descr") 'basket(i, 5) = sp("package")("base")(i)("bill_cust_descr") 'basket(i, 6) = sp("package")("base")(i)("ship_cust_descr") 'basket(i, 7) = sp("package")("base")(i)("units") 'basket(i, 8) = sp("package")("base")(i)("value_usd") basket(i, 0) = sp("package")("basket")(i)("part_descr") basket(i, 1) = sp("package")("basket")(i)("bill_cust_descr") basket(i, 2) = sp("package")("basket")(i)("ship_cust_descr") basket(i, 3) = sp("package")("basket")(i)("mix") Next i '---------------get list of customers---------------------------- ReDim cust(sp("package")("customers").Count - 1, 3) For i = 0 To UBound(cust, 1) cust(i, 0) = sp("package")("customers")(i + 1)("bill_cust_descr") cust(i, 1) = "" cust(i, 2) = sp("package")("customers")(i + 1)("ship_cust_descr") cust(i, 3) = "" Next i Call x.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace") '-------------load tags------------------------------- If Not IsNull(sp("package")("tags")) Then ReDim tags(sp("package")("tags").Count - 1, 0) For i = 1 To sp("package")("tags").Count tags(i - 1, 0) = sp("package")("tags")(i) Next i cbTAG.list = tags Sheets("month").cbMTAG.list = tags cbTAG.ListRows = UBound(tags, 1) + 1 months.cbMTAG.ListRows = UBound(tags, 1) + 1 End If '----------reset spinner buttons---------------------- sbpv.value = 0 sbpp.value = 0 sbpd.value = 0 '--------reset swap tab------------------------------- lbSWAP.clear pickSWAP.value = "" pickSWAP.text = Mid(sp("package")("basket")(1)("part_descr"), 1, 8) pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F2").CurrentRegion) cbBT.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion) cbST.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion) lbCUST.list = cust Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit") '---------price volume radio button colors---------- If opPlugPrice.value = True Then opPlugPrice.BackColor = -2147483624 Else opPlugPrice.BackColor = -2147483644 End If If opPlugVol.value = True Then opPlugVol.BackColor = -2147483624 Else opPlugVol.BackColor = -2147483644 End If Call handler.month_tosheet(month, basket) Application.StatusBar = False Me.mp.Visible = True End Sub Sub crunch_array() Dim i As Integer month(13, 1) = 0 month(13, 2) = 0 month(13, 3) = 0 month(13, 4) = 0 month(13, 5) = 0 month(13, 6) = 0 month(13, 7) = 0 month(13, 8) = 0 For i = 1 To 12 month(13, 1) = month(13, 1) + co_num(month(i, 1), 0) month(13, 2) = month(13, 2) + co_num(month(i, 2), 0) month(13, 3) = month(13, 3) + co_num(month(i, 3), 0) month(13, 4) = month(13, 4) + co_num(month(i, 4), 0) month(13, 5) = month(13, 5) + co_num(month(i, 5), 0) month(13, 6) = month(13, 6) + co_num(month(i, 6), 0) month(13, 7) = month(13, 7) + co_num(month(i, 7), 0) month(13, 8) = month(13, 8) + co_num(month(i, 8), 0) Next i ReDim mload(UBound(month, 1), 5) For i = 0 To UBound(month, 1) mload(i, 0) = month(i, 0) mload(i, 1) = Format(month(i, 1), "#,###") mload(i, 2) = Format(month(i, 4), "#,###") mload(i, 3) = Format(month(i, 5), "#,###") mload(i, 4) = Format(month(i, 8), "#,###") Next i 'mline = 0 clear_lb = True lbMonth.clear lbMonth.list = mload clear_lb = False End Sub Private Sub lbCUST_Change() Dim i As Long Dim x() As Variant x = lbCUST.list For i = 0 To UBound(x, 1) If lbCUST.Selected(i) Then Exit For Next i cbBT.text = x(i, 0) cbST.text = x(i, 2) End Sub Private Sub cbBT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode <> 13 Then Exit Sub Dim i As Long Dim x() As Variant x = lbCUST.list For i = 0 To UBound(x, 1) If lbCUST.Selected(i) Then x(i, 1) = Me.rev_cust(cbBT.text) Next i lbCUST.list = x Call Me.build_cust_swap End Sub Private Sub cbST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode <> 13 Then Exit Sub Dim i As Long Dim x() As Variant x = lbCUST.list For i = 0 To UBound(x, 1) If lbCUST.Selected(i) Then x(i, 3) = Me.rev_cust(cbST.text) Next i lbCUST.list = x Call Me.build_cust_swap End Sub Sub build_cust_swap() Dim vtable() As Variant Dim ptable As String vtable = lbCUST.list vtable = x.ARRAYp_TransposeVar(vtable) vtable = x.ARRAYp_zerobased_addheader(vtable, "bill", "bill_r", "ship", "ship_r") vtable = x.ARRAYp_TransposeVar(vtable) ptable = x.json_from_table_zb(vtable, "rows", True, False) Set cswap = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}") cswap("scenario")("version") = handler.plan cswap("scenario")("iter") = handler.basis cswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") cswap("user") = Application.UserName cswap("source") = "adj" cswap("message") = tbCOM.text cswap("tag") = cbTAG.text cswap("type") = "cust_swap" Set cswap("swap") = JsonConverter.ParseJson(ptable) tbAPI.text = JsonConverter.ConvertToJson(cswap) End Sub Public Function rev_cust(cust As String) As String If cust = "" Then rev_cust = "" Exit Function End If If InStr(1, cust, " - ") <= 9 Then rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(Left(cust, 8)) Else rev_cust = trim(Right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - ")) End If End Function Sub load_var() 'base bVolm = co_num(month(mline, 2), 0) bValm = co_num(month(mline, 6), 0) 'prior adjust pVolm = co_num(month(mline, 3), 0) pValm = co_num(month(mline, 7), 0) 'current forecast fVolm = co_num(month(mline, 4), 0) fValm = co_num(month(mline, 8), 0) 'adjustment aVolm = fVolm - (bVolm + pVolm) aValm = fValm - (bValm + pValm) If month(mline, 9) = "addmonth" Then nomonth = True bPrcm = month(13, 6) / month(13, 2) fPrcm = month(13, 8) / month(13, 4) Else 'prices If bVolm <> 0 Then bPrcm = bValm / bVolm If (bVolm + pVolm) <> 0 Then pPrcm = (pValm + bValm) / (bVolm + pVolm) - bPrcm If fVolm <> 0 Then fPrcm = fValm / fVolm aPrcm = fPrcm - (bPrcm + pPrcm) End If End Sub Sub load_mbox() load_tb = True tbMBaseVol = Format(bVolm, "#,###") tbMBaseVal = Format(bValm, "#,###") tbMBasePrice = Format(bPrcm, "0.00000") tbMPAVol = Format(pVolm, "#,###") tbmPAVal = Format(pValm, "#,###") tbMPAPrice = Format(pPrcm, "0.00000") tbMFVol = Format(fVolm, "#,###") tbMFVal = Format(fValm, "#,###") If Not set_Price Then tbMFPrice = Format(fPrcm, "0.#####") tbMAVol = Format(aVolm, "#,###") tbMAVal = Format(aValm, "#,###") tbMAPrice = Format(aPrcm, "0.00000") load_tb = False End Sub Sub load_mbox_ann() load_tb = True tbBaseVol = Format(bVol, "#,##0") tbBaseVal = Format(bVal, "#,##0") tbBasePrice = Format(bPrc, "0.00000") tbPadjVol = Format(pVol, "#,##0") tbPadjVal = Format(pVal, "#,##0") tbPadjPrice = Format(pPrc, "0.00000") tbFcVol = Format(fVol, "#,##0") tbFcVal = Format(fVal, "#,##0") If Not set_Price Then tbFcPrice = Format(fPrc, "0.00000") tbAdjVol = Format(aVol, "#,##0") tbAdjVal = Format(aVal, "#,##0") tbAdjPrice = Format(aPrc, "0.00000") load_tb = False End Sub Sub load_array() 'base month(mline, 2) = bVolm month(mline, 6) = bValm 'prior adjust month(mline, 3) = pVolm month(mline, 7) = pValm 'current forecast month(mline, 4) = fVolm month(mline, 8) = fValm Me.crunch_array End Sub Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant If Not IsNumeric(one) Or IsNull(one) Then co_num = two Else co_num = one End If End Function Sub calc_val() Dim pchange As Double If IsNumeric(tbFcVal.value) Then 'get textbox value fVal = tbFcVal.value 'do calculations aVal = fVal - bVal - pVal '---------if volume adjustment method is selected, scale the volume up---------------------------------- If opPlugVol Then If (Round(pVal, 2) + Round(bVal, 2)) = 0 Then pchange = 0 If co_num(pVal, bVal) = 0 Then MsgBox ("a new part was added, and then adjusted to -0-") Else fVol = fVal / (co_num(bVal, pVal) / co_num(bVol, pVol)) End If Else pchange = fVal / (pVal + bVal) fVol = (pVol + bVol) * pchange End If Else fVol = pVol + bVol End If If fVol = 0 Then fPrc = 0 Else fPrc = fVal / fVol End If aVol = fVol - (bVol + pVol) aPrc = fPrc - (bPrc + pPrc) Else aVol = fVol - bVol - pVol aPrc = 0 End If tbFcVal = Format(co_num(tbFcVal, 0), "#,##0") Me.load_mbox_ann 'build json Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") adjust("scenario")("version") = handler.plan adjust("scenario")("iter") = handler.basis adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") adjust("user") = Application.UserName adjust("source") = "adj" adjust("message") = tbCOM.text adjust("tag") = cbTAG.text If opEditSales Then If opPlugVol Then adjust("type") = "scale_v" adjust("amount") = aVal adjust("qty") = aVol Else adjust("type") = "scale_p" adjust("amount") = aVal End If Else adjust("type") = "scale_vp" adjust("qty") = aVol adjust("amount") = aVal End If 'print json tbAPI = JsonConverter.ConvertToJson(adjust) End Sub Sub calc_price() 'If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then 'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then 'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) Then 'capture currently changed item fVol = co_num(tbFcVol.value, 0) fPrc = co_num(tbFcPrice.value, 0) 'calc fVal = fPrc * fVol aVal = fVal - bVal - pVal aVol = fVol - (bVol + pVol) If (bVol + pVol) = 0 Then aPrc = 0 Else 'aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol)) aPrc = fPrc - (bPrc + pPrc) End If 'End If Me.load_mbox_ann 'build json Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") adjust("scenario")("version") = handler.plan adjust("scenario")("iter") = handler.basis adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") adjust("user") = Application.UserName adjust("source") = "adj" adjust("message") = tbCOM.text adjust("tag") = cbTAG.text adjust("version") = handler.plan If opEditSales Then If opPlugVol Then adjust("type") = "scale_v" adjust("amount") = aVal Else adjust("type") = "scale_p" adjust("amount") = aVal End If Else If aVol = 0 Then adjust("type") = "scale_p" Else adjust("type") = "scale_vp" End If adjust("qty") = aVol adjust("amount") = aVal End If 'print json tbAPI = JsonConverter.ConvertToJson(adjust) End Sub Sub calc_mval() Dim pchange As Double Dim j As Object If IsNumeric(tbMFVal.value) Then 'get textbox value fValm = tbMFVal.value 'do calculations aValm = fValm - bValm - pValm '---------if volume adjustment method is selected, scale the volume up---------------------------------- If nomonth Then fVolm = fValm / bPrcm fPrcm = bPrcm Else If opmvol Then pchange = fValm / (pValm + bValm) fVolm = (pVolm + bVolm) * pchange Else fVolm = pVolm + bVolm End If End If If fVolm = 0 Then fPrcm = 0 Else fPrcm = fValm / fVolm End If aVolm = fVolm - (bVolm + pVolm) aPrcm = fPrcm - (bPrcm + pPrcm) Else aVolm = fVolm - bVolm - pVolm aPrcm = 0 End If tbMFVal = Format(tbMFVal, "#,###") 'build json Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") j("scenario")("version") = handler.plan j("scenario")("iter") = handler.basis j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") j("user") = Application.UserName j("source") = "adj" If opEditSalesM Then If opmvol Then If nomonth Then j("type") = "addmonth_v" j("month") = month(mline, 0) Else j("type") = "scale_v" j("scenario")("order_month") = month(mline, 0) End If j("amount") = aValm Else If nomonth Then j("type") = "addmonth_p" j("month") = month(mline, 0) Else j("type") = "scale_p" j("scenario")("order_month") = month(mline, 0) End If j("amount") = aValm End If Else If nomonth Then j("type") = "addmonth_vp" j("month") = month(mline, 0) Else j("type") = "scale_vp" j("scenario")("order_month") = month(mline, 0) End If j("qty") = aVolm j("amount") = aValm End If month(mline, 10) = JsonConverter.ConvertToJson(j) tbAPI = JsonConverter.ConvertToJson(j) Me.load_mbox Me.load_array End Sub Sub calc_mprice() Dim j As Object If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 And IsNumeric(tbMFVol.value) And tbMFVol.value <> 0 Then 'capture currently changed item fVolm = tbMFVol.value fPrcm = tbMFPrice.value 'calc fValm = fPrcm * fVolm aValm = fValm - bValm - pValm aVolm = fVolm - (bVolm + pVolm) If nomonth Then aPrcm = fValm / fVolm - bPrcm Else aPrcm = fValm / fVolm - ((bValm + pValm) / (bVolm + pVolm)) End If Else fValm = 0 aValm = fValm - bValm - pValm End If 'build json Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") j("scenario")("version") = handler.plan j("scenario")("iter") = handler.basis j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") j("user") = Application.UserName j("source") = "adj" If opEditSalesM Then If opmvol Then If nomonth Then j("type") = "addmonth_v" j("month") = month(mline, 0) Else j("type") = "scale_v" j("scenario")("order_month") = month(mline, 0) End If j("amount") = aValm Else If nomonth Then 'this scenario should be prevented j("type") = "addmonth_v" j("month") = month(mline, 0) Else j("type") = "scale_p" j("scenario")("order_month") = month(mline, 0) End If j("amount") = aValm End If Else If nomonth Then j("type") = "addmonth_vp" j("month") = month(mline, 0) Else If aVolm = 0 Then j("type") = "scale_p" Else j("type") = "scale_vp" End If j("scenario")("order_month") = month(mline, 0) End If j("qty") = aVolm j("amount") = aValm End If month(mline, 10) = JsonConverter.ConvertToJson(j) tbAPI = JsonConverter.ConvertToJson(j) If clear_lb Then MsgBox ("clear") Me.load_mbox Me.load_array End Sub Function iter_def(ByVal iter As String) As String Dim i As Integer For i = 0 To UBound(handler.baseline) If handler.baseline(i) = iter Then iter_def = "baseline" Exit Function End If Next i For i = 0 To UBound(handler.adjust) If handler.adjust(i) = iter Then iter_def = "adjust" Exit Function End If Next i iter_def = "exclude" End Function Sub new_part() End Sub