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