VBA/fpvt.frm

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt 
   Caption         =   "Forecast Adjustment"
   ClientHeight    =   7260
   ClientLeft      =   120
   ClientTop       =   465
   ClientWidth     =   17475
   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 sp As Object
Private basket() As Variant

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 cbGoSheet_Click()

    Me.Hide
    Worksheets("month").Visible = xlSheetVisible
    Sheets("month").Select

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 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
    If fVol = 0 Then
        fPrc = 0
    Else
        fPrc = fVal / fVol
    End If
    If (bVol + pVol) = 0 Then
        pPrc = 0
    Else
        pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
    End If
    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
    
    ReDim basket(sp("package")("basket").Count, 3)
    
'    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
    
    Call handler.month_tosheet(month, basket)
    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