VBA/fpvt.frm

1056 lines
26 KiB
Plaintext
Raw Normal View History

2019-02-28 01:47:56 -05:00
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
2019-03-01 15:49:59 -05:00
Caption = "Forecast Adjustment"
2020-02-14 02:27:01 -05:00
ClientHeight = 8445.001
2019-02-28 01:47:56 -05:00
ClientLeft = 120
ClientTop = 465
2020-02-14 02:27:01 -05:00
ClientWidth = 8820.001
2019-02-28 01:47:56 -05:00
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
2019-03-05 11:41:11 -05:00
Private month() As Variant
Private mload() As Variant
2019-03-05 16:18:02 -05:00
Private adjust As Object
2019-03-06 04:25:25 -05:00
Private nomonth As Boolean
Private mline As Integer
Private clear_lb As Boolean
Private load_tb As Boolean
Private set_Price As Boolean
2019-03-15 11:10:44 -04:00
Private sp As Object
2019-03-19 01:03:43 -04:00
Private basket() As Variant
2019-03-06 04:25:25 -05:00
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
2019-03-05 16:18:02 -05:00
2019-02-28 01:47:56 -05:00
Option Explicit
2019-03-01 15:49:59 -05:00
Private Sub cbCancel_Click()
tbAdjVol.value = 0
tbAdjVal.value = 0
tbAdjPrice.value = 0
fpvt.Hide
End Sub
2019-03-05 16:18:02 -05:00
Private Sub butAdjust_Click()
2019-03-14 13:52:41 -04:00
Dim fail As Boolean
2020-02-14 17:24:02 -05:00
If adjust("source") = "" Then
MsgBox ("No adjustments provided")
Exit Sub
End If
2020-02-14 02:27:01 -05:00
2020-02-18 17:04:03 -05:00
If cbTAG.text = "" Then
MsgBox ("no tag was selected")
Exit Sub
End If
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
If fail Then
MsgBox ("adjustment was not made due to error")
Exit Sub
End If
2019-03-14 13:52:41 -04:00
2020-02-14 17:24:02 -05:00
Me.tbCOM = ""
2020-02-18 17:04:03 -05:00
Me.cbTAG.text = ""
2020-02-14 17:24:02 -05:00
2019-03-05 16:18:02 -05:00
Me.Hide
2019-03-14 13:52:41 -04:00
Set adjust = Nothing
2019-03-01 15:49:59 -05:00
End Sub
2019-03-05 16:18:02 -05:00
Private Sub butCancel_Click()
Me.Hide
End Sub
2019-03-01 15:49:59 -05:00
2019-03-05 17:10:08 -05:00
Private Sub butMAdjust_Click()
2019-03-06 06:29:20 -05:00
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
2019-03-06 06:29:20 -05:00
Me.Hide
End Sub
Private Sub butMCancel_Click()
Me.Hide
End Sub
2019-03-15 11:10:44 -04:00
Private Sub cbGoSheet_Click()
2020-02-18 02:07:38 -05:00
Worksheets("month").tbMCOM.text = ""
Worksheets("month").sbMPV.value = 0
Worksheets("month").sbMPP.value = 0
2019-03-15 11:10:44 -04:00
Me.Hide
2019-03-20 01:43:18 -04:00
Worksheets("month").Visible = xlSheetVisible
2019-03-15 11:10:44 -04:00
Sheets("month").Select
End Sub
2020-02-18 02:07:38 -05:00
Private Sub cbTAG_Change()
If tbAPI.text = "" Then tbAPI.text = "{}"
Set adjust = JsonConverter.ParseJson(tbAPI.text)
adjust("tag") = cbTAG.value
tbAPI.text = JsonConverter.ConvertToJson(adjust)
End Sub
2020-02-14 02:27:01 -05:00
Private Sub Label64_Click()
End Sub
2019-03-05 11:41:11 -05:00
Private Sub lbMonth_Change()
2019-03-06 04:25:25 -05:00
If clear_lb Or load_tb Then Exit Sub
2019-03-05 11:41:11 -05:00
Dim i As Long
2019-03-06 04:25:25 -05:00
For i = 0 To 13
2019-03-05 11:41:11 -05:00
If lbMonth.Selected(i) Then
mline = i
2019-03-06 04:25:25 -05:00
If i <> 0 And i <> 13 Then
Me.load_var
Me.load_mbox
2019-03-05 11:41:11 -05:00
Else
2019-03-06 04:25:25 -05:00
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
2019-03-05 11:41:11 -05:00
End If
Exit For
End If
Next i
2019-03-22 18:18:23 -04:00
End Sub
Private Sub lheader_Click()
2019-03-05 11:41:11 -05:00
End Sub
2019-03-05 16:18:02 -05:00
Private Sub opEditPrice_Click()
2019-03-05 16:18:02 -05:00
opPlugVol.Enabled = False
opPlugPrice.Enabled = False
opPlugVol.Visible = False
opPlugPrice.Visible = False
opPlugPrice.value = True
opPlugVol.value = False
2019-03-05 11:41:11 -05:00
2019-03-05 16:18:02 -05:00
tbFcPrice.Enabled = True
tbFcPrice.BackColor = &H80000018
tbFcVal.Enabled = False
tbFcVal.BackColor = &H80000005
tbFcVol.Enabled = True
tbFcVol.BackColor = &H80000018
2019-03-05 11:41:11 -05:00
2020-02-18 02:07:38 -05:00
sbpv.Enabled = True
sbpp.Enabled = True
sbpd.Enabled = False
tbpv.Enabled = True
tbpp.Enabled = True
tbpd.Enabled = False
2019-03-05 11:41:11 -05:00
End Sub
2019-03-05 16:18:02 -05:00
Private Sub opEditSales_Click()
2019-03-05 16:18:02 -05:00
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
2020-02-18 02:07:38 -05:00
sbpv.Enabled = False
sbpp.Enabled = False
sbpd.Enabled = True
tbpv.Enabled = False
tbpp.Enabled = False
tbpd.Enabled = True
2019-03-05 11:41:11 -05:00
End Sub
2019-03-01 15:49:59 -05:00
2019-03-05 17:10:08 -05:00
Private Sub opEditPriceM_Click()
2019-03-05 17:10:08 -05:00
opmvol.Enabled = False
opmprice.Enabled = False
opmvol.Visible = False
opmprice.Visible = False
opmprice.value = True
opmvol.value = True
2019-03-05 17:10:08 -05:00
tbMFPrice.Enabled = True
tbMFPrice.BackColor = &H80000018
tbMFVal.Enabled = False
tbMFVal.BackColor = &H80000005
tbMFVol.Enabled = True
tbMFVol.BackColor = &H80000018
2019-03-05 17:10:08 -05:00
End Sub
Private Sub opEditSalesM_Click()
2019-03-05 17:10:08 -05:00
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()
2019-03-05 17:10:08 -05:00
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
2019-03-05 16:18:02 -05:00
Private Sub opPlugPrice_Click()
calc_val
2019-03-01 15:49:59 -05:00
End Sub
2019-03-05 16:18:02 -05:00
Private Sub opPlugVol_Click()
calc_val
2019-03-01 15:49:59 -05:00
End Sub
2020-02-18 02:07:38 -05:00
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
2020-02-14 02:27:01 -05:00
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
2019-03-05 16:18:02 -05:00
Private Sub tbFcPrice_Change()
2019-03-14 13:52:41 -04:00
If load_tb Then Exit Sub
set_Price = True
2019-03-05 16:18:02 -05:00
If opEditPrice Then calc_price
2019-03-14 13:52:41 -04:00
set_Price = False
2019-02-28 01:47:56 -05:00
End Sub
2019-03-05 16:18:02 -05:00
Private Sub tbFcVal_Change()
2020-02-18 02:07:38 -05:00
2019-03-14 13:52:41 -04:00
If load_tb Then Exit Sub
2019-03-05 16:18:02 -05:00
If opEditSales Then calc_val
2020-02-18 02:07:38 -05:00
2019-03-05 16:18:02 -05:00
End Sub
2019-03-05 11:41:11 -05:00
2019-03-05 16:18:02 -05:00
Private Sub tbFcVol_Change()
If load_tb Then Exit Sub
If opEditPrice Then calc_price
2019-03-05 11:41:11 -05:00
End Sub
2019-03-05 17:44:02 -05:00
'--------------------------------monthly buttons--------------------------------------
Private Sub opmPrice_Click()
2019-03-06 04:44:08 -05:00
calc_mval
2019-03-05 17:44:02 -05:00
End Sub
Private Sub opmVol_Click()
2019-03-06 04:44:08 -05:00
calc_mval
2019-03-05 17:44:02 -05:00
End Sub
Private Sub tbmfPrice_Change()
2020-02-18 02:07:38 -05:00
2019-03-06 04:25:25 -05:00
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
set_Price = True
2019-03-05 17:44:02 -05:00
If opEditPriceM Then calc_mprice
2019-03-06 04:25:25 -05:00
set_Price = False
2020-02-18 02:07:38 -05:00
2019-03-05 17:44:02 -05:00
End Sub
2019-03-06 04:25:25 -05:00
2019-03-05 17:44:02 -05:00
2019-03-06 04:44:08 -05:00
Private Sub tbMFVal_Change()
2020-02-18 02:07:38 -05:00
2019-03-06 04:44:08 -05:00
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
If opEditSalesM Then calc_mval
2020-02-18 02:07:38 -05:00
2019-03-06 04:44:08 -05:00
End Sub
2019-03-05 17:44:02 -05:00
Private Sub tbmfVol_Change()
2020-02-18 02:07:38 -05:00
2019-03-06 04:25:25 -05:00
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
If opEditPriceM Then calc_mprice
2020-02-18 02:07:38 -05:00
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)
2019-03-05 17:44:02 -05:00
End Sub
2019-02-28 01:47:56 -05:00
Private Sub UserForm_Activate()
Dim i As Long
2019-03-05 11:41:11 -05:00
Dim j As Long
Dim k As Long
2019-03-01 15:49:59 -05:00
Dim ok As Boolean
2020-02-18 02:07:38 -05:00
Dim tags() As Variant
2019-03-22 18:18:23 -04:00
Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2)
Me.mp.Visible = False
2019-03-22 18:18:23 -04:00
Me.lheader = "Loading..."
2019-02-28 01:47:56 -05:00
2019-03-14 13:52:41 -04:00
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
2019-03-01 15:49:59 -05:00
2019-03-22 18:18:23 -04:00
Me.lheader = "Ready"
2019-03-01 15:49:59 -05:00
If Not ok Then
fpvt.Hide
Application.StatusBar = False
Exit Sub
End If
2019-02-28 01:47:56 -05:00
'---show existing adjustment if there is one----
fpvt.mod_adjust = False
2019-03-14 13:52:41 -04:00
pVol = 0
pVal = 0
pPrc = 0
2019-03-14 13:52:41 -04:00
bVol = 0
bVal = 0
bPrc = 0
aVol = 0
aVal = 0
aPrc = 0
fVal = 0
fVol = 0
fPrc = 0
2019-03-25 16:04:04 -04:00
Me.tbAPI.value = ""
2019-02-28 01:47:56 -05:00
2019-03-22 18:18:23 -04:00
If IsNull(sp("package")("totals")) Then
fpvt.Hide
Application.StatusBar = False
Exit Sub
End If
2019-03-05 11:39:35 -05:00
For i = 1 To sp("package")("totals").Count
Select Case sp("package")("totals")(i)("order_season")
Case 2021
2019-03-14 13:52:41 -04:00
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
2019-02-28 01:47:56 -05:00
2019-03-14 13:52:41 -04:00
Case "adjust"
pVol = pVol + sp("package")("totals")(i)("units")
pVal = pVal + sp("package")("totals")(i)("value_usd")
Case "exclude"
2019-03-01 15:49:59 -05:00
2019-02-28 01:47:56 -05:00
End Select
End Select
Next i
2019-03-14 13:52:41 -04:00
fVol = bVol + pVol
fVal = bVal + pVal
2019-03-20 01:43:18 -04:00
If fVol = 0 Then
fPrc = 0
Else
fPrc = fVal / fVol
End If
If (bVol + pVol) = 0 Then
pPrc = 0
Else
2019-03-22 10:54:05 -04:00
If bVol = 0 Then
pPrc = 0
Else
pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
End If
2019-03-20 01:43:18 -04:00
End If
If aVal <> 0 Then
MsgBox (aVal)
End If
2019-03-14 13:52:41 -04:00
Me.load_mbox_ann
2019-03-01 15:49:59 -05:00
2019-03-05 11:39:35 -05:00
'---------------------------------------populate monthly-------------------------------------------------------
2019-03-05 11:41:11 -05:00
k = 0
2019-03-05 11:39:35 -05:00
'--parse json into variant array for loading--
2019-03-06 04:25:25 -05:00
ReDim month(sp("package")("mpvt").Count + 1, 10)
2019-03-05 11:41:11 -05:00
For i = 1 To sp("package")("mpvt").Count
month(i, 0) = sp("package")("mpvt")(i)("order_month")
2020-02-14 02:27:01 -05:00
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")
2019-03-06 04:25:25 -05:00
If co_num(month(i, 2), 0) = 0 Then
month(i, 9) = "addmonth"
Else
month(i, 9) = "scale"
End If
2019-03-05 11:41:11 -05:00
Next i
2019-03-05 11:39:35 -05:00
2019-03-05 11:41:11 -05:00
month(0, 0) = "month"
2019-03-06 04:25:25 -05:00
month(13, 0) = "total"
2020-02-14 02:27:01 -05:00
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"
2019-03-05 11:41:11 -05:00
2019-03-06 04:25:25 -05:00
Me.crunch_array
2019-03-19 01:03:43 -04:00
2019-03-19 15:43:31 -04:00
ReDim basket(sp("package")("basket").Count, 3)
2019-03-19 01:03:43 -04:00
' 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
2020-02-18 02:07:38 -05:00
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
2020-02-18 17:04:03 -05:00
Sheets("month").cbMTAG.list = tags
2020-02-18 02:07:38 -05:00
End If
2019-03-19 01:03:43 -04:00
Call handler.month_tosheet(month, basket)
2019-03-06 04:25:25 -05:00
Application.StatusBar = False
Me.mp.Visible = True
2019-03-06 04:25:25 -05:00
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
2019-03-05 11:41:11 -05:00
ReDim mload(UBound(month, 1), 5)
For i = 0 To UBound(month, 1)
2019-03-06 04:25:25 -05:00
mload(i, 0) = Format(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), "#,###")
2019-03-05 11:41:11 -05:00
Next i
2019-03-06 04:25:25 -05:00
'mline = 0
clear_lb = True
lbMonth.clear
2019-03-05 11:41:11 -05:00
lbMonth.list = mload
2019-03-06 04:25:25 -05:00
clear_lb = False
End Sub
Sub load_var()
'base
bVolm = co_num(month(mline, 2), 0)
bValm = co_num(month(mline, 6), 0)
2019-03-05 11:41:11 -05:00
2019-03-06 04:25:25 -05:00
'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)
2019-02-28 01:47:56 -05:00
2019-03-06 04:25:25 -05:00
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
2019-02-28 01:47:56 -05:00
End Sub
2019-03-05 11:41:11 -05:00
2019-03-06 04:25:25 -05:00
Sub load_mbox()
load_tb = True
tbMBaseVol = Format(bVolm, "#,###")
tbMBaseVal = Format(bValm, "#,###")
2020-02-18 02:07:38 -05:00
tbMBasePrice = Format(bPrcm, "0.00000")
2019-03-06 04:25:25 -05:00
tbMPAVol = Format(pVolm, "#,###")
tbmPAVal = Format(pValm, "#,###")
2020-02-18 02:07:38 -05:00
tbMPAPrice = Format(pPrcm, "0.00000")
2019-03-06 04:25:25 -05:00
tbMFVol = Format(fVolm, "#,###")
tbMFVal = Format(fValm, "#,###")
2020-02-18 02:07:38 -05:00
If Not set_Price Then tbMFPrice = Format(fPrcm, "0.#####")
2019-03-06 04:25:25 -05:00
tbMAVol = Format(aVolm, "#,###")
tbMAVal = Format(aValm, "#,###")
2020-02-18 02:07:38 -05:00
tbMAPrice = Format(aPrcm, "0.00000")
2019-03-06 04:25:25 -05:00
load_tb = False
End Sub
2019-03-14 13:52:41 -04:00
Sub load_mbox_ann()
load_tb = True
tbBaseVol = Format(bVol, "#,##0")
tbBaseVal = Format(bVal, "#,##0")
2020-02-18 02:07:38 -05:00
tbBasePrice = Format(bPrc, "0.00000")
2019-03-14 13:52:41 -04:00
tbPadjVol = Format(pVol, "#,##0")
tbPadjVal = Format(pVal, "#,##0")
2020-02-18 02:07:38 -05:00
tbPadjPrice = Format(pPrc, "0.00000")
2019-03-14 13:52:41 -04:00
tbFcVol = Format(fVol, "#,##0")
tbFcVal = Format(fVal, "#,##0")
2020-02-18 02:07:38 -05:00
If Not set_Price Then tbFcPrice = Format(fPrc, "0.00000")
2019-03-14 13:52:41 -04:00
tbAdjVol = Format(aVol, "#,##0")
tbAdjVal = Format(aVal, "#,##0")
2020-02-18 02:07:38 -05:00
tbAdjPrice = Format(aPrc, "0.00000")
2019-03-14 13:52:41 -04:00
load_tb = False
End Sub
2019-03-06 04:25:25 -05:00
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
2019-03-05 11:41:11 -05:00
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
If Not IsNumeric(one) Or IsNull(one) Then
2019-03-05 11:41:11 -05:00
co_num = two
Else
co_num = one
End If
End Function
2019-03-05 16:18:02 -05:00
Sub calc_val()
Dim pchange As Double
2019-03-14 13:52:41 -04:00
2019-03-05 16:18:02 -05:00
If IsNumeric(tbFcVal.value) Then
2019-03-14 13:52:41 -04:00
'get textbox value
fVal = tbFcVal.value
'do calculations
aVal = fVal - bVal - pVal
2019-03-05 16:18:02 -05:00
'---------if volume adjustment method is selected, scale the volume up----------------------------------
If opPlugVol Then
2019-04-03 04:45:51 -04:00
If (Round(pVal, 2) + Round(bVal, 2)) = 0 Then
pchange = 0
2019-04-03 04:45:51 -04:00
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)
2019-04-03 04:45:51 -04:00
fVol = (pVol + bVol) * pchange
End If
2019-04-03 04:45:51 -04:00
2019-03-14 13:52:41 -04:00
Else
fVol = pVol + bVol
End If
If fVol = 0 Then
fPrc = 0
2019-03-05 16:18:02 -05:00
Else
2019-03-14 13:52:41 -04:00
fPrc = fVal / fVol
2019-03-05 16:18:02 -05:00
End If
2019-03-14 13:52:41 -04:00
aVol = fVol - (bVol + pVol)
aPrc = fPrc - (bPrc + pPrc)
2019-03-05 16:18:02 -05:00
Else
2019-03-14 13:52:41 -04:00
aVol = fVol - bVol - pVol
aPrc = 0
2019-03-05 16:18:02 -05:00
End If
tbFcVal = Format(co_num(tbFcVal, 0), "#,##0")
2019-03-14 13:52:41 -04:00
Me.load_mbox_ann
2019-03-05 16:18:02 -05:00
'build json
2019-03-06 06:29:20 -05:00
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("scenario")("version") = handler.plan
2019-03-14 13:52:41 -04:00
adjust("scenario")("iter") = handler.basis
2019-03-05 16:18:02 -05:00
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName
2019-03-14 13:52:41 -04:00
adjust("source") = "adj"
2020-02-14 02:27:01 -05:00
adjust("message") = tbCOM.text
2020-02-18 17:04:03 -05:00
adjust("tag") = cbTAG.text
2019-03-06 06:29:20 -05:00
If opEditSales Then
If opPlugVol Then
adjust("type") = "scale_v"
2019-03-14 13:52:41 -04:00
adjust("amount") = aVal
2019-04-03 04:45:51 -04:00
adjust("qty") = aVol
2019-03-06 06:29:20 -05:00
Else
adjust("type") = "scale_p"
2019-03-14 13:52:41 -04:00
adjust("amount") = aVal
2019-03-06 06:29:20 -05:00
End If
2019-03-05 16:18:02 -05:00
Else
2019-03-06 06:29:20 -05:00
adjust("type") = "scale_vp"
2019-03-14 13:52:41 -04:00
adjust("qty") = aVol
adjust("amount") = aVal
2019-03-05 16:18:02 -05:00
End If
2019-03-06 06:29:20 -05:00
'print json
tbAPI = JsonConverter.ConvertToJson(adjust)
2019-03-05 16:18:02 -05:00
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
2019-03-05 16:18:02 -05:00
Else
'aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol))
aPrc = fPrc - (bPrc + pPrc)
2019-03-05 16:18:02 -05:00
End If
'End If
2019-03-05 16:18:02 -05:00
2019-03-14 13:52:41 -04:00
Me.load_mbox_ann
2019-03-06 06:29:20 -05:00
'build json
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("scenario")("version") = handler.plan
adjust("scenario")("iter") = handler.basis
2019-03-06 06:29:20 -05:00
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName
2019-03-14 13:52:41 -04:00
adjust("source") = "adj"
2020-02-14 02:27:01 -05:00
adjust("message") = tbCOM.text
2020-02-18 17:04:03 -05:00
adjust("tag") = cbTAG.text
adjust("version") = handler.plan
2019-03-06 06:29:20 -05:00
If opEditSales Then
If opPlugVol Then
adjust("type") = "scale_v"
2019-03-14 13:52:41 -04:00
adjust("amount") = aVal
2019-03-06 06:29:20 -05:00
Else
adjust("type") = "scale_p"
2019-03-14 13:52:41 -04:00
adjust("amount") = aVal
2019-03-06 06:29:20 -05:00
End If
Else
2019-03-14 13:52:41 -04:00
If aVol = 0 Then
adjust("type") = "scale_p"
Else
adjust("type") = "scale_vp"
End If
adjust("qty") = aVol
adjust("amount") = aVal
2019-03-06 06:29:20 -05:00
End If
'print json
tbAPI = JsonConverter.ConvertToJson(adjust)
2019-03-05 16:18:02 -05:00
End Sub
2019-03-05 17:10:08 -05:00
Sub calc_mval()
Dim pchange As Double
2019-03-06 06:29:20 -05:00
Dim j As Object
2019-03-05 17:10:08 -05:00
2019-03-05 17:44:02 -05:00
If IsNumeric(tbMFVal.value) Then
'get textbox value
2019-03-06 04:44:08 -05:00
fValm = tbMFVal.value
'do calculations
2019-03-06 04:44:08 -05:00
aValm = fValm - bValm - pValm
2019-03-05 17:10:08 -05:00
'---------if volume adjustment method is selected, scale the volume up----------------------------------
If nomonth Then
fVolm = fValm / bPrcm
fPrcm = bPrcm
2019-03-05 17:10:08 -05:00
Else
If opmvol Then
pchange = fValm / (pValm + bValm)
fVolm = (pVolm + bVolm) * pchange
Else
fVolm = pVolm + bVolm
End If
2019-03-05 17:10:08 -05:00
End If
2019-03-14 13:52:41 -04:00
If fVolm = 0 Then
fPrcm = 0
Else
fPrcm = fValm / fVolm
End If
2019-03-06 04:44:08 -05:00
aVolm = fVolm - (bVolm + pVolm)
aPrcm = fPrcm - (bPrcm + pPrcm)
2019-03-05 17:10:08 -05:00
Else
2019-03-06 04:44:08 -05:00
aVolm = fVolm - bVolm - pVolm
aPrcm = 0
2019-03-05 17:10:08 -05:00
End If
tbMFVal = Format(tbMFVal, "#,###")
2019-03-06 06:29:20 -05:00
'build json
2019-03-14 13:52:41 -04:00
2019-03-06 06:29:20 -05:00
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
j("scenario")("version") = handler.plan
2019-03-14 13:52:41 -04:00
j("scenario")("iter") = handler.basis
2019-03-06 06:29:20 -05:00
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
j("user") = Application.UserName
2019-03-14 13:52:41 -04:00
j("source") = "adj"
2019-03-06 06:29:20 -05:00
If opEditSalesM Then
If opmvol Then
If nomonth Then
j("type") = "addmonth_v"
j("month") = month(mline, 0)
Else
j("type") = "scale_v"
2019-03-14 13:52:41 -04:00
j("scenario")("order_month") = month(mline, 0)
2019-03-06 06:29:20 -05:00
End If
j("amount") = aValm
Else
If nomonth Then
j("type") = "addmonth_p"
j("month") = month(mline, 0)
Else
j("type") = "scale_p"
2019-03-14 13:52:41 -04:00
j("scenario")("order_month") = month(mline, 0)
2019-03-06 06:29:20 -05:00
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"
2019-03-14 13:52:41 -04:00
j("scenario")("order_month") = month(mline, 0)
2019-03-06 06:29:20 -05:00
End If
j("qty") = aVolm
j("amount") = aValm
End If
month(mline, 10) = JsonConverter.ConvertToJson(j)
tbAPI = JsonConverter.ConvertToJson(j)
2019-03-06 04:44:08 -05:00
Me.load_mbox
Me.load_array
2019-03-05 17:10:08 -05:00
End Sub
Sub calc_mprice()
2019-03-06 06:29:20 -05:00
Dim j As Object
If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 And IsNumeric(tbMFVol.value) And tbMFVol.value <> 0 Then
2019-03-06 04:25:25 -05:00
'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
2019-03-05 17:10:08 -05:00
Else
2019-03-06 04:25:25 -05:00
fValm = 0
aValm = fValm - bValm - pValm
2019-03-05 17:10:08 -05:00
End If
2019-03-06 06:29:20 -05:00
'build json
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
j("scenario")("version") = handler.plan
2019-03-14 13:52:41 -04:00
j("scenario")("iter") = handler.basis
2019-03-06 06:29:20 -05:00
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
j("user") = Application.UserName
2019-03-14 13:52:41 -04:00
j("source") = "adj"
2019-03-06 06:29:20 -05:00
If opEditSalesM Then
If opmvol Then
If nomonth Then
j("type") = "addmonth_v"
j("month") = month(mline, 0)
Else
j("type") = "scale_v"
2019-03-14 13:52:41 -04:00
j("scenario")("order_month") = month(mline, 0)
2019-03-06 06:29:20 -05:00
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"
2019-03-14 13:52:41 -04:00
j("scenario")("order_month") = month(mline, 0)
2019-03-06 06:29:20 -05:00
End If
j("amount") = aValm
End If
Else
If nomonth Then
j("type") = "addmonth_vp"
j("month") = month(mline, 0)
Else
2019-03-14 13:52:41 -04:00
If aVolm = 0 Then
j("type") = "scale_p"
Else
j("type") = "scale_vp"
End If
j("scenario")("order_month") = month(mline, 0)
2019-03-06 06:29:20 -05:00
End If
j("qty") = aVolm
j("amount") = aValm
End If
month(mline, 10) = JsonConverter.ConvertToJson(j)
tbAPI = JsonConverter.ConvertToJson(j)
2019-03-06 04:25:25 -05:00
If clear_lb Then MsgBox ("clear")
Me.load_mbox
Me.load_array
2019-03-05 17:10:08 -05:00
End Sub
2019-03-14 13:52:41 -04:00
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
2019-03-14 13:52:41 -04:00