86225ea7e5
Lots of cleanup here too, removing large swaths of code that are no longer needed. Many improvements the Excel workbook, which is kept in Teams, not git. These changes may or may not have had accompanying VBA changes.
566 lines
15 KiB
Plaintext
566 lines
15 KiB
Plaintext
VERSION 5.00
|
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
|
|
Caption = "Forecast Adjustment"
|
|
ClientHeight = 8490.001
|
|
ClientLeft = 120
|
|
ClientTop = 465
|
|
ClientWidth = 8670.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
|
|
Option Explicit
|
|
|
|
Private month() As Variant
|
|
Private adjust As Object
|
|
Private load_tb As Boolean
|
|
Private set_Price As Boolean
|
|
Private sp As Object
|
|
|
|
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
|
|
|
|
'=====================================================================================================
|
|
' Developers' backdoor to enter or exit debug mode: Ctrl-RightClick on the "Selected Scenario"
|
|
' label at the top of the form. Debug Mode shows the Pending Changes tab in the form, as well
|
|
' as all hidden sheets.
|
|
Private Sub Label62_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
|
|
If Button = 2 And Shift = 2 Then
|
|
shConfig.Range("debug_mode") = Not shConfig.Range("debug_mode")
|
|
mp.Pages("pAPIDOC").Visible = shConfig.Range("debug_mode")
|
|
End If
|
|
End Sub
|
|
'=====================================================================================================
|
|
|
|
Private Sub butAdjust_Click()
|
|
Dim fail As Boolean
|
|
Dim msg As String
|
|
|
|
If tbAPI.text = "" Then msg = "No adjustments provided."
|
|
If cbTAG.text = "" Then msg = "No tag was selected."
|
|
If tbAPI.text = "" Then msg = "No adjustements are ready."
|
|
|
|
If msg <> "" Then
|
|
MsgBox msg, vbOKOnly Or vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
Call handler.request_adjust(tbAPI.text, fail)
|
|
If fail Then
|
|
MsgBox "Adjustment was not made due to error.", vbOKOnly Or vbExclamation
|
|
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 cbGoSheet_Click()
|
|
shMonthView.Range("MonthComment").Value = ""
|
|
shMonthView.Range("MonthTag").Value = ""
|
|
shMonthView.Range("QtyPctChange").Value = 0
|
|
shMonthView.Range("PricePctChange").Value = 0
|
|
shMonthView.Visible = xlSheetVisible
|
|
shMonthView.Select
|
|
Me.Hide
|
|
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 opEditPrice_Click()
|
|
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.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 opPlugPrice_Click()
|
|
calc_val
|
|
End Sub
|
|
|
|
Private Sub opPlugVol_Click()
|
|
calc_val
|
|
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
|
|
|
|
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()
|
|
Me.Caption = "Forecast Adjust " & shConfig.Range("version").Value & " Loading..."
|
|
Me.mp.Visible = False
|
|
Me.fraExit.Visible = False
|
|
|
|
Dim ok As Boolean
|
|
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
|
|
Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
|
|
|
|
Me.Caption = "Forecast Adjust " & shConfig.Range("version").Value
|
|
|
|
If Not ok Then
|
|
fpvt.Hide
|
|
Application.StatusBar = False
|
|
Exit Sub
|
|
End If
|
|
|
|
'---show existing adjustment if there is one----
|
|
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
|
|
MsgBox "An unexpected error has occurred when retrieving the scenario.", vbOKOnly Or vbExclamation, "Error"
|
|
fpvt.Hide
|
|
Application.StatusBar = False
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long
|
|
For i = 1 To sp("package")("totals").Count
|
|
Select Case sp("package")("totals")(i)("order_season")
|
|
Case 2024
|
|
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-------------------------------------------------------
|
|
|
|
'--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)("2023 qty")
|
|
month(i, 2) = sp("package")("mpvt")(i)("2024 base qty")
|
|
month(i, 3) = sp("package")("mpvt")(i)("2024 adj qty")
|
|
month(i, 4) = sp("package")("mpvt")(i)("2024 tot qty")
|
|
month(i, 5) = sp("package")("mpvt")(i)("2023 value_usd")
|
|
month(i, 6) = sp("package")("mpvt")(i)("2024 base value_usd")
|
|
month(i, 7) = sp("package")("mpvt")(i)("2024 adj value_usd")
|
|
month(i, 8) = sp("package")("mpvt")(i)("2024 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
|
|
|
|
Me.crunch_array
|
|
|
|
ReDim basket(sp("package")("basket").Count, 3)
|
|
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")("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
|
|
|
|
'-------------load tags-------------------------------
|
|
cbTAG.list = shConfig.ListObjects("TAGS").DataBodyRange.Value
|
|
|
|
'----------reset spinner buttons----------------------
|
|
sbpv.Value = 0
|
|
sbpp.Value = 0
|
|
sbpd.Value = 0
|
|
|
|
Call handler.month_tosheet(month, basket)
|
|
Application.StatusBar = False
|
|
|
|
Me.mp.Visible = True
|
|
Me.fraExit.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
|
|
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_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
|
|
|
|
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 "Zero times any number is zero. Cannot scale to get to the target."
|
|
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()
|
|
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
|
|
|
|
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
|
|
|
|
|
|
|