VBA/fpvt.frm
2019-03-14 13:52:41 -04:00

812 lines
20 KiB
Plaintext

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
Caption = "Forecast Adjustment"
ClientHeight = 7260
ClientLeft = 120
ClientTop = 465
ClientWidth = 16140
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 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()
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust))
Me.Hide
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 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 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
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
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
End Sub
Private Sub opPlugVol_Click()
calc_val
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 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 UserForm_Activate()
Dim sp As Object
Dim i As Long
Dim j As Long
Dim k As Long
Dim ok As Boolean
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
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
bVol = 0
bVal = 0
For i = 1 To sp("package")("totals").Count
Select Case sp("package")("totals")(i)("order_season")
Case 2020
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
fPrc = fVal / fVol
pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
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)("2019 qty")
month(i, 2) = sp("package")("mpvt")(i)("2020 base qty")
month(i, 3) = sp("package")("mpvt")(i)("2020 adj qty")
month(i, 4) = sp("package")("mpvt")(i)("2020 tot qty")
month(i, 5) = sp("package")("mpvt")(i)("2019 value_usd")
month(i, 6) = sp("package")("mpvt")(i)("2020 base value_usd")
month(i, 7) = sp("package")("mpvt")(i)("2020 adj value_usd")
month(i, 8) = sp("package")("mpvt")(i)("2020 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) = "2019 qty"
month(0, 2) = "2020 base qty"
month(0, 3) = "2020 adj qty"
month(0, 4) = "2020 qty"
month(0, 5) = "2019 val"
month(0, 6) = "2020 base val"
month(0, 7) = "2020 adj val"
month(0, 8) = "2020 val"
Me.crunch_array
Application.StatusBar = False
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) = 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), "#,###")
Next i
'mline = 0
clear_lb = True
lbMonth.clear
lbMonth.list = mload
clear_lb = False
End Sub
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.000")
tbMPAVol = Format(pVolm, "#,###")
tbmPAVal = Format(pValm, "#,###")
tbMPAPrice = Format(pPrcm, "0.000")
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.000")
load_tb = False
End Sub
Sub load_mbox_ann()
load_tb = True
tbBaseVol = Format(bVol, "#,###")
tbBaseVal = Format(bVal, "#,###")
tbBasePrice = Format(bPrc, "0.000")
tbPadjVol = Format(pVol, "#,###")
tbPadjVal = Format(pVal, "#,###")
tbPadjPrice = Format(pPrc, "0.000")
tbFcVol = Format(fVol, "#,###")
tbFcVal = Format(fVal, "#,###")
If Not set_Price Then tbFcPrice = Format(fPrc, "0.###")
tbAdjVol = Format(aVol, "#,###")
tbAdjVal = Format(aVal, "#,###")
tbAdjPrice = Format(aPrc, "0.000")
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 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
pchange = fVal / (pVal + bVal)
fVol = (pVol + bVol) * pchange
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(tbFcVal, "#,###")
Me.load_mbox_ann
'build json
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("scenario")("version") = "b20"
adjust("scenario")("iter") = handler.basis
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName
adjust("source") = "adj"
If opEditSales Then
If opPlugVol Then
adjust("type") = "scale_v"
adjust("amount") = aVal
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
'capture currently changed item
fVol = tbFcVol.value
fPrc = tbFcPrice.value
'calc
fVal = fPrc * fVol
aVal = fVal - bVal - pVal
aVol = fVol - (bVol + pVol)
If nomonth Then
aPrc = fVal / fVol - bPrc
Else
aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol))
End If
Else
fVal = 0
aVal = fVal - bVal - pVal
End If
Me.load_mbox_ann
'build json
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName
adjust("source") = "adj"
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") = "b20"
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") = "b20"
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