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 Option Explicit Private Sub cbCancel_Click() tbAdjVol.value = 0 tbAdjVal.value = 0 tbAdjPrice.value = 0 fpvt.Hide End Sub Private Sub butAdjust_Click() MsgBox ("adjustment posted") Me.Hide End Sub Private Sub butCancel_Click() Me.Hide End Sub Private Sub butMAdjust_Click() End Sub Private Sub butMCancel_Click() Me.Hide End Sub Private Sub lbMonth_Change() Dim i As Long For i = 0 To 12 If lbMonth.Selected(i) Then If i <> 0 Then If co_num(month(i, 6), 0) = 0 And co_num(month(i, 2), 0) = 0 Then tbMBaseVal.value = 0 tbMBaseVol.value = 0 tbmPAVal.value = 0 tbMPAVol.value = 0 tbMFVal.value = 0 tbMFVol.value = 0 tbMBasePrice = 0 tbMFPrice = 0 End If '------------base------------------------------------- tbMBaseVal.value = co_num(month(i, 6), 0) tbMBaseVol.value = co_num(month(i, 2), 0) tbmPAVal.value = co_num(month(i, 7), 0) tbMPAVol.value = co_num(month(i, 3), 0) tbMFVal.value = co_num(month(i, 8), 0) tbMFVol.value = co_num(month(i, 4), 0) If tbMBaseVol <> 0 Then tbMBasePrice = Format(tbMBaseVal / tbMBaseVol, "#.000") Else tbMBasePrice = 0 End If If tbMFVol <> 0 Then tbMFPrice = Format(tbMFVal / tbMFVol, "#.000") Else tbMFPrice = 0 End If Else tbMBaseVal.value = 0 tbMBaseVol.value = 0 tbmPAVal.value = 0 tbMPAVol.value = 0 tbMFVal.value = 0 tbMFVol.value = 0 tbMBasePrice = 0 tbMFPrice = 0 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 opEditPrice Then calc_price End Sub Private Sub tbFcVal_Change() 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 opEditPriceM Then calc_mprice End Sub Private Sub tbmfVal_Change() If opEditSalesM Then calc_mval End Sub Private Sub tbmfVol_Change() 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 'handler.server = "http://10.56.1.20:3000" handler.server = "http://192.168.1.69:3000" Set sp = handler.scenario_package(handler.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 fpvt.tbPadjVol.Text = 0 fpvt.tbPadjVal.Text = 0 For i = 1 To sp("package")("totals").Count Select Case sp("package")("totals")(i)("order_season") Case 2020 Select Case sp("package")("totals")(i)("iter") Case "copy" fpvt.tbBaseVol.Text = Format(sp("package")("totals")(i)("units"), "#,###") fpvt.tbBaseVal.Text = Format(sp("package")("totals")(i)("value_usd"), "#,###") If sp("package")("totals")(i)("units") <> 0 Then fpvt.tbBasePrice.Text = Format(sp("package")("totals")(i)("value_usd") / sp("package")("totals")(i)("units"), "#.000") Case "adjustment" fpvt.tbPadjVol.Text = Format(sp("package")("totals")(i)("units"), "#,###") fpvt.tbPadjVal.Text = Format(sp("package")("totals")(i)("value_usd"), "#,###") End Select End Select Next i fpvt.tbFcVol.value = Format(CDbl(fpvt.tbBaseVol.value) + CDbl(fpvt.tbPadjVol.value), "#,###") fpvt.tbFcVal.value = Format(CDbl(fpvt.tbBaseVal.value) + CDbl(fpvt.tbPadjVal.value), "#") fpvt.tbFcPrice.value = Format(CDbl(fpvt.tbFcVal.value) / CDbl(fpvt.tbFcVol.value), "#.000") fpvt.tbPadjPrice.value = Format((CDbl(fpvt.tbPadjVal.value) + CDbl(tbBaseVal.value)) / (CDbl(fpvt.tbBaseVol.value) + CDbl(tbPadjVol.value)) - CDbl(tbBaseVal) / CDbl(tbBaseVol), "#.000") '---------------------------------------populate monthly------------------------------------------------------- k = 0 '--parse json into variant array for loading-- ReDim month(sp("package")("mpvt").Count, 8) For i = 1 To sp("package")("mpvt").Count month(i, 0) = sp("package")("mpvt")(i)("order_month") month(i, 1) = Format(sp("package")("mpvt")(i)("2019 qty"), "#,###") month(i, 2) = Format(sp("package")("mpvt")(i)("2020 base qty"), "#,###") month(i, 3) = Format(sp("package")("mpvt")(i)("2020 adj qty"), "#,###") month(i, 4) = Format(sp("package")("mpvt")(i)("2020 tot qty"), "#,###") month(i, 5) = Format(sp("package")("mpvt")(i)("2019 value_usd"), "#,###") month(i, 6) = Format(sp("package")("mpvt")(i)("2020 base value_usd"), "#,###") month(i, 7) = Format(sp("package")("mpvt")(i)("2020 adj value_usd"), "#,###") month(i, 8) = Format(sp("package")("mpvt")(i)("2020 tot value_usd"), "#,###") Next i month(0, 0) = "month" 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" ReDim mload(UBound(month, 1), 5) For i = 0 To UBound(month, 1) mload(i, 0) = month(i, 0) mload(i, 1) = month(i, 1) mload(i, 2) = month(i, 4) mload(i, 3) = month(i, 5) mload(i, 4) = month(i, 8) Next i lbMonth.list = mload lbMonth.ColumnCount = 8 'MsgBox (lbMonth.list(0, 0)) Application.StatusBar = False 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 'calculate percent change pchange = CDbl(tbFcVal.value) / (CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value)) 'plug the adjustment required tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###") '---------if volume adjustment method is selected, scale the volume up---------------------------------- If opPlugVol Then tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)) * pchange, "#,###") Else tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)), "#,###") End If tbFcPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value), "#.000") tbAdjVol = Format(tbFcVol - (CDbl(tbBaseVol) + CDbl(tbPadjVol)), "#,###") tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((CDbl(tbBaseVal.value) + CDbl(tbPadjVal.value)) / (CDbl(tbBaseVol.value) + CDbl(tbPadjVol.value))), "#.000") Else 'tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value), "#,###") tbAdjVol = Format((CDbl(tbFcVol.value) - CDbl(tbBaseVol.value) - CDbl(tbPadjVol.value)), "#,###") tbAdjPrice = 0 'tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((tbBaseVal + tbPadjVal) / (tbBaseVol + tbPadjVol)), "#.000") End If tbFcVal = Format(CDbl(tbFcVal), "#,##0") 'build json Set adjust = JsonConverter.ParseJson("{""scneario"":" & scenario & "}") adjust("type") = "increment" If opPlugVol Then adjust("vp") = "v" Else adjust("vp") = "p" End If adjust("amount") = tbAdjVal adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") adjust("user") = Application.UserName 'print json 'tbJSON = JsonConverter.ConvertToJson(adjust) End Sub Sub calc_vol() Dim pchange As Double If IsNumeric(tbFcVol.value) And tbFcVol <> 0 Then 'price should already have been re-calculated to base + prior at this point tbFcVal = Format(CDbl(tbFcPrice.value) * CDbl(tbFcVol.value)) 'calculate percent change 'pchange = CDbl(tbFcVal.value) / (CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value)) 'plug the adjustment required tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###") tbAdjVol = Format(tbFcVol - (CDbl(tbBaseVol) + CDbl(tbPadjVol)), "#,###") tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((CDbl(tbBaseVal.value) + CDbl(tbPadjVal.value)) / (CDbl(tbBaseVol.value) + CDbl(tbPadjVol.value))), "#.000") Else tbFcVal = 0 tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###") tbAdjPrice = Format((tbBaseVal + tbPadjVal) / (tbBaseVol + tbPadjVol), "#.000") tbAdjVol = Format(-CDbl(tbBaseVol.value) - CDbl(tbPadjVol.value), "#,###") End If tbFcVal = Format(tbFcVal, "#,###") End Sub Sub calc_price() If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then tbFcVal = Format(CDbl(tbFcPrice.value) * CDbl(tbFcVol.value), "#,##0") tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###") tbAdjVol = Format(tbFcVol - (CDbl(tbBaseVol) + CDbl(tbPadjVol)), "#,###") tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((CDbl(tbBaseVal.value) + CDbl(tbPadjVal.value)) / (CDbl(tbBaseVol.value) + CDbl(tbPadjVol.value))), "#.000") Else tbFcVal = 0 tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###") End If End Sub Sub calc_mval() Dim pchange As Double If IsNumeric(tbMFVal.value) Then 'calculate percent change If (CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value)) = 0 Then Exit Sub pchange = CDbl(tbMFVal.value) / (CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value)) 'plug the adjustment required tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###") '---------if volume adjustment method is selected, scale the volume up---------------------------------- If opmvol Then tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###") Else tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###") End If tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000") tbMAVol = Format(tbMFVol - (CDbl(tbMBaseVol) + CDbl(tbMPAVol)), "#,###") tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbmPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000") Else 'tbMFVal = Format(CDbl(tbMPAVal.value) + CDbl(tbMBaseVal.value), "#,###") tbMAVol = Format((CDbl(tbMFVol.value) - CDbl(tbMBaseVol.value) - CDbl(tbMPAVol.value)), "#,###") tbMAPrice = 0 'tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((tbMBaseVal + tbMPAVal) / (tbMBaseVol + tbMPAVol)), "#.000") End If tbMFVal = Format(tbMFVal, "#,###") End Sub Sub calc_mprice() If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 And IsNumeric(tbMFVol.value) And tbMFVol.value <> 0 Then tbMFVal = Format(CDbl(tbMFPrice.value) * CDbl(tbMFVol.value), "#,##0") tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###") tbMAVol = Format(tbMFVol - (CDbl(tbMBaseVol) + CDbl(tbMPAVol)), "#,###") tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbmPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000") Else tbMFVal = 0 tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###") End If End Sub Sub calc_mvol() Dim pchange As Double If IsNumeric(tbMFVol.value) And tbMFVol <> 0 Then 'price should already have been re-calculated to base + prior at this point tbMFVal = Format(CDbl(tbMFPrice.value) * CDbl(tbMFVol.value)) 'calculate percent change 'pchange = CDbl(tbMFVal.value) / (CDbl(tbMPAVal.value) + CDbl(tbMBaseVal.value)) 'plug the adjustment required tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###") tbMAVol = Format(tbMFVol - (CDbl(tbMBaseVol) + CDbl(tbMPAVol)), "#,###") tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbmPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000") Else tbMFVal = 0 tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###") tbMAPrice = Format((tbMBaseVal + tbmPAVal) / (tbMBaseVol + tbMPAVol), "#.000") tbMAVol = Format(-CDbl(tbMBaseVol.value) - CDbl(tbMPAVol.value), "#,###") End If tbMFVol = Format(CDbl(tbMFVol), "#,###") End Sub