accomodate new sql builder parameters, and test for presence of price sheet

build.frm

@@ -0,0 +1,78 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build 
+   Caption         =   "UserForm1"
+   ClientHeight    =   3015
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   8100
+   OleObjectBlob   =   "build.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "build"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Public part As String
+Public bill As String
+Public ship As String
+Public useval As Boolean
+Option Explicit
+
+
+
+
+Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+    Select Case KeyCode
+        Case 13
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+End Sub
+
+
+Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+
+    Select Case KeyCode
+        Case 13
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+
+End Sub
+
+
+Private Sub cbShip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+    Select Case KeyCode
+        Case 13
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+End Sub
+
+Private Sub UserForm_Activate()
+    
+    useval = False
+    
+    cbPart.value = part
+    cbBill.value = bill
+    cbShip.value = ship
+    
+    cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
+    cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
+    cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
+    
+
+End Sub
+
+
+

changes.frm

@@ -0,0 +1,53 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes 
+   Caption         =   "History"
+   ClientHeight    =   7740
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   16260
+   OleObjectBlob   =   "changes.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "changes"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Private x As Variant
+
+Private Sub cbCancel_Click()
+
+    Me.Hide
+
+End Sub
+
+Private Sub lbHist_Change()
+
+    Dim i As Integer
+
+    For i = 0 To Me.lbHist.ListCount - 1
+        If Me.lbHist.Selected(i) Then
+            Me.tbPrint.value = x(i, 4)
+            Exit Sub
+        End If
+    Next i
+        
+    
+
+End Sub
+
+
+
+Private Sub UserForm_Activate()
+
+    Dim fail As Boolean
+    
+    x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
+    If fail Then
+        Me.Hide
+        Exit Sub
+    End If
+    Me.lbHist.list = x
+
+End Sub
+

fpvt.frm

@@ -0,0 +1,929 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt 
+   Caption         =   "Forecast Adjustment"
+   ClientHeight    =   7350
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   7110
+   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()
+    
+    Dim fail As Boolean
+    
+    Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
+    If fail Then
+        MsgBox ("adjustment was not made due to error")
+        Exit Sub
+    End If
+    
+    Me.Hide
+    
+    Set adjust = Nothing
+    
+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 lheader_Click()
+
+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 load_tb Then Exit Sub
+    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
+    
+    Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2)
+    Me.mp.Visible = False
+    
+    Me.lheader = "Loading..."
+
+    Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
+    
+    Me.lheader = "Ready"
+    
+    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
+    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
+        fpvt.Hide
+        Application.StatusBar = False
+        Exit Sub
+    End If
+    
+    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
+        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-------------------------------------------------------
+    
+    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
+    
+    Me.mp.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) = 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, "#,##0")
+    tbBaseVal = Format(bVal, "#,##0")
+    tbBasePrice = Format(bPrc, "0.000")
+    
+    tbPadjVol = Format(pVol, "#,##0")
+    tbPadjVal = Format(pVal, "#,##0")
+    tbPadjPrice = Format(pPrc, "0.000")
+    
+    tbFcVol = Format(fVol, "#,##0")
+    tbFcVal = Format(fVal, "#,##0")
+    If Not set_Price Then tbFcPrice = Format(fPrc, "0.000")
+    
+    tbAdjVol = Format(aVol, "#,##0")
+    tbAdjVal = Format(aVal, "#,##0")
+    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 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 ("a new part was added, and then adjusted to -0-")
+                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") = "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
+            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()
+    
+    'If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
+    'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
+    
+    'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) Then
+    'capture currently changed item
+    
+    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") = "b20"
+    adjust("scenario")("iter") = handler.basis
+    adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
+    adjust("user") = Application.UserName
+    adjust("source") = "adj"
+    adjust("version") = "b20"
+    
+    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
+
+Sub new_part()
+
+End Sub
+
+

handler.bas

@@ -0,0 +1,519 @@
+Attribute VB_Name = "handler"
+Option Explicit
+
+Public sql As String
+Public jsql As String
+Public scenario As String
+Public sc() As Variant
+Public x As New TheBigOne
+Public wapi As New Windows_API
+Public data() As String
+Public agg() As String
+Public showprice As Boolean
+Public server As String
+Public basis() As Variant
+Public baseline() As Variant
+Public adjust() As Variant
+
+
+Sub load_fpvt()
+
+    Application.StatusBar = "retrieving selection data....."
+    
+    'data = x.SHTp_Get("data", 1, 1, True)
+    'Call x.TBLp_Aggregate(data, True, True, True, Array(1, 3), Array("S", "S"), Array(30))
+    Dim i As Long
+    Dim s_tot As Object
+    
+    fpvt.ListBox1.list = handler.sc
+    
+    showprice = False
+    
+    For i = 0 To UBound(handler.sc, 1)
+        If handler.sc(i, 0) = "part_descr" Then
+            showprice = True
+            Exit For
+        End If
+    Next i
+       
+    
+    fpvt.Show
+     
+
+
+End Sub
+
+Function scenario_package(doc As String, ByRef status As Boolean) As Object
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    
+    On Error GoTo errh
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/scenario_package", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+    Set scenario_package = json
+    
+errh:
+    If Err.Number <> 0 Then
+        status = False
+        MsgBox (Err.Description)
+        Set scenario_package = Nothing
+    Else
+        status = True
+    End If
+    
+End Function
+
+Sub pg_main_workset(rep As String)
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim wapi As New Windows_API
+    Dim wr As String
+    Dim json As Object
+    Dim i As Long
+    Dim j As Long
+    Dim doc As String
+    Dim res() As Variant
+    Dim str() As String
+    
+    doc = "{""quota_rep"":""" & rep & """}"
+         
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", handler.server & "/get_pool", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+    ReDim res(json("x").Count, 32)
+    
+    For i = 1 To UBound(res, 1)
+        res(i, 0) = json("x")(i)("bill_cust_descr")
+        res(i, 1) = json("x")(i)("billto_group")
+        res(i, 2) = json("x")(i)("ship_cust_descr")
+        res(i, 3) = json("x")(i)("shipto_group")
+        res(i, 4) = json("x")(i)("quota_rep_descr")
+        res(i, 5) = json("x")(i)("director_descr")
+        res(i, 6) = json("x")(i)("segm")
+        res(i, 7) = json("x")(i)("mod_chan")
+        res(i, 8) = json("x")(i)("mod_chansub")
+        res(i, 9) = json("x")(i)("majg_descr")
+        res(i, 10) = json("x")(i)("ming_descr")
+        res(i, 11) = json("x")(i)("majs_descr")
+        res(i, 12) = json("x")(i)("mins_descr")
+        res(i, 13) = json("x")(i)("brand")
+        res(i, 14) = json("x")(i)("part_family")
+        res(i, 15) = json("x")(i)("part_group")
+        res(i, 16) = json("x")(i)("branding")
+        res(i, 17) = json("x")(i)("color")
+        res(i, 18) = json("x")(i)("part_descr")
+        res(i, 19) = json("x")(i)("order_season")
+        res(i, 20) = json("x")(i)("order_month")
+        res(i, 21) = json("x")(i)("ship_season")
+        res(i, 22) = json("x")(i)("ship_month")
+        res(i, 23) = json("x")(i)("request_season")
+        res(i, 24) = json("x")(i)("request_month")
+        res(i, 25) = json("x")(i)("promo")
+        res(i, 26) = json("x")(i)("version")
+        res(i, 27) = json("x")(i)("iter")
+        res(i, 28) = json("x")(i)("value_loc")
+        res(i, 29) = json("x")(i)("value_usd")
+        res(i, 30) = json("x")(i)("cost_loc")
+        res(i, 31) = json("x")(i)("cost_usd")
+        res(i, 32) = json("x")(i)("units")
+    Next i
+    
+    res(0, 0) = "bill_cust_descr"
+    res(0, 1) = "billto_group"
+    res(0, 2) = "ship_cust_descr"
+    res(0, 3) = "shipto_group"
+    res(0, 4) = "quota_rep_descr"
+    res(0, 5) = "director_descr"
+    res(0, 6) = "segm"
+    res(0, 7) = "mod_chan"
+    res(0, 8) = "mod_chansub"
+    res(0, 9) = "majg_descr"
+    res(0, 10) = "ming_descr"
+    res(0, 11) = "majs_descr"
+    res(0, 12) = "mins_descr"
+    res(0, 13) = "brand"
+    res(0, 14) = "part_family"
+    res(0, 15) = "part_group"
+    res(0, 16) = "branding"
+    res(0, 17) = "color"
+    res(0, 18) = "part_descr"
+    res(0, 19) = "order_season"
+    res(0, 20) = "order_month"
+    res(0, 21) = "ship_season"
+    res(0, 22) = "ship_month"
+    res(0, 23) = "request_season"
+    res(0, 24) = "request_month"
+    res(0, 25) = "promo"
+    res(0, 26) = "version"
+    res(0, 27) = "iter"
+    res(0, 28) = "value_loc"
+    res(0, 29) = "value_usd"
+    res(0, 30) = "cost_loc"
+    res(0, 31) = "cost_usd"
+    res(0, 32) = "units"
+    
+    Set json = Nothing
+
+    ReDim str(UBound(res, 1), UBound(res, 2))
+    
+    Worksheets("data").Cells.ClearContents
+    Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
+    
+
+End Sub
+
+Sub pull_rep()
+
+    openf.Show
+
+End Sub
+
+
+
+Function request_adjust(doc As String, ByRef fail As Boolean) As Object
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Long
+    Dim j As Long
+    Dim str() As String
+    
+    If doc = "" Then
+        fail = True
+        Exit Function
+    End If
+    
+    'update timestamp
+    Set json = JsonConverter.ParseJson(doc)
+    'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
+    'doc = JsonConverter.ConvertToJson(doc)
+    
+    server = Sheets("config").Cells(1, 2)
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "POST", server & "/" & json("type"), True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+    
+    If Mid(wr, 2, 5) = "error" Then
+        MsgBox (wr)
+        fail = True
+        Exit Function
+    End If
+    
+    If Mid(wr, 1, 6) = "<body>" Then
+        MsgBox (wr)
+        fail = True
+        Exit Function
+    End If
+    
+    If Mid(wr, 1, 6) = "<!DOCT" Then
+        MsgBox (wr)
+        fail = True
+        Exit Function
+    End If
+
+    Set json = JsonConverter.ParseJson(wr)
+    
+    If IsNull(json("x")) Then
+        MsgBox ("no adjustment was made")
+        fail = True
+        Exit Function
+    End If
+    
+    ReDim res(json("x").Count - 1, 32)
+    
+    For i = 1 To UBound(res, 1) + 1
+        res(i - 1, 0) = json("x")(i)("bill_cust_descr")
+        res(i - 1, 1) = json("x")(i)("billto_group")
+        res(i - 1, 2) = json("x")(i)("ship_cust_descr")
+        res(i - 1, 3) = json("x")(i)("shipto_group")
+        res(i - 1, 4) = json("x")(i)("quota_rep_descr")
+        res(i - 1, 5) = json("x")(i)("director_descr")
+        res(i - 1, 6) = json("x")(i)("segm")
+        res(i - 1, 7) = json("x")(i)("mod_chan")
+        res(i - 1, 8) = json("x")(i)("mod_chansub")
+        res(i - 1, 9) = json("x")(i)("majg_descr")
+        res(i - 1, 10) = json("x")(i)("ming_descr")
+        res(i - 1, 11) = json("x")(i)("majs_descr")
+        res(i - 1, 12) = json("x")(i)("mins_descr")
+        res(i - 1, 13) = json("x")(i)("brand")
+        res(i - 1, 14) = json("x")(i)("part_family")
+        res(i - 1, 15) = json("x")(i)("part_group")
+        res(i - 1, 16) = json("x")(i)("branding")
+        res(i - 1, 17) = json("x")(i)("color")
+        res(i - 1, 18) = json("x")(i)("part_descr")
+        res(i - 1, 19) = json("x")(i)("order_season")
+        res(i - 1, 20) = json("x")(i)("order_month")
+        res(i - 1, 21) = json("x")(i)("ship_season")
+        res(i - 1, 22) = json("x")(i)("ship_month")
+        res(i - 1, 23) = json("x")(i)("request_season")
+        res(i - 1, 24) = json("x")(i)("request_month")
+        res(i - 1, 25) = json("x")(i)("promo")
+        res(i - 1, 26) = json("x")(i)("version")
+        res(i - 1, 27) = json("x")(i)("iter")
+        res(i - 1, 28) = json("x")(i)("value_loc")
+        res(i - 1, 29) = json("x")(i)("value_usd")
+        res(i - 1, 30) = json("x")(i)("cost_loc")
+        res(i - 1, 31) = json("x")(i)("cost_usd")
+        res(i - 1, 32) = json("x")(i)("units")
+    Next i
+    
+    Set json = Nothing
+
+    ReDim str(UBound(res, 1), UBound(res, 2))
+    
+'    For i = 0 To UBound(res, 1)
+'        For j = 0 To UBound(res, 2)
+'            If IsNull(res(i, j)) Then
+'                str(i, j) = ""
+'            Else
+'                str(i, j) = res(i, j)
+'            End If
+'        Next j
+'    Next i
+    
+    i = 1
+    Do Until Sheets("data").Cells(i, 1) = ""
+        i = i + 1
+    Loop
+    
+    Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
+    
+    
+    'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
+    
+    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    
+End Function
+
+Sub load_config()
+
+    Dim i As Integer
+    Dim j As Integer
+    '----server to use---------------------------------------------------------
+    handler.server = Sheets("config").Cells(1, 2)
+    '---basis-----------------------------------------------------------------
+    ReDim handler.basis(100)
+    i = 2
+    j = 0
+    Do While Sheets("config").Cells(2, i) <> ""
+        handler.basis(j) = Sheets("config").Cells(2, i)
+        j = j + 1
+        i = i + 1
+    Loop
+    ReDim Preserve handler.basis(j - 1)
+    '---baseline-----------------------------------------------------------------
+    ReDim handler.baseline(100)
+    i = 2
+    j = 0
+    Do While Sheets("config").Cells(3, i) <> ""
+        handler.baseline(j) = Sheets("config").Cells(3, i)
+        j = j + 1
+        i = i + 1
+    Loop
+    ReDim Preserve handler.baseline(j - 1)
+    '---adjustments-----------------------------------------------------------------
+    ReDim handler.adjust(100)
+    i = 2
+    j = 0
+    Do While Sheets("config").Cells(4, i) <> ""
+        handler.adjust(j) = Sheets("config").Cells(4, i)
+        j = j + 1
+        i = i + 1
+    Loop
+    ReDim Preserve handler.adjust(j - 1)
+    
+End Sub
+
+Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
+
+    Dim j As Object
+    Dim i As Integer
+    Dim r As Long
+    Dim sh As Worksheet
+    Set sh = Sheets("_month")
+    
+    Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
+    sh.Cells(1, 16) = JsonConverter.ConvertToJson(j)
+    
+    For i = 0 To 12
+        '------------volume-------------------
+        sh.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
+        sh.Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
+        sh.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
+        sh.Cells(i + 1, 4) = 0
+        sh.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
+        
+        '------------value----------------------
+        sh.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
+        sh.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
+        sh.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
+        sh.Cells(i + 1, 14) = 0
+        sh.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
+        
+        '-------------price----------------------
+        If i > 0 Then
+            '--prior--
+            If co_num(pkg(i, 1), 0) = 0 Then
+                sh.Cells(i + 1, 6) = 0
+            Else
+                sh.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
+            End If
+            
+            '--base--
+            If co_num(pkg(i, 2), 0) = 0 Then
+                'if there is no monthly base volume,
+                'then use the prior price, if there was no prior price,
+                'then inherit the average price for the year before current adjustments
+                If sh.Cells(i, 7) <> 0 Then
+                    sh.Cells(i + 1, 7) = sh.Cells(i, 7)
+                Else
+                    If pkg(13, 1) + pkg(13, 2) = 0 Then
+                        sh.Cells(i + 1, 7) = 0
+                    Else
+                        sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
+                    End If
+                End If
+            Else
+                sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
+            End If
+            
+            '--adjust--
+            If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
+                sh.Cells(i + 1, 8) = 0
+            Else
+                sh.Cells(i + 1, 8) = (pkg(i, 7) + pkg(i, 6)) / (pkg(i, 3) + pkg(i, 2)) - (pkg(i, 6) / pkg(i, 2))
+            End If
+            
+            '--current adjust--
+            sh.Cells(i + 1, 9) = 0
+            
+            '--forecast--
+            If co_num(pkg(i, 4), 0) = 0 Then
+                'if there is no monthly base volume,
+                'then use the prior price, if there was no prior price,
+                'then inherit the average price for the year before current adjustments
+                If sh.Cells(i, 10) <> 0 Then
+                    sh.Cells(i + 1, 10) = sh.Cells(i, 10)
+                Else
+                    If pkg(13, 1) + pkg(13, 2) = 0 Then
+                        sh.Cells(i + 1, 10) = 0
+                    Else
+                        sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
+                    End If
+                End If
+            Else
+                sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
+            End If
+            
+        End If
+        
+    Next i
+    
+    'scenario
+    Sheets("_month").Range("R1:S1000").ClearContents
+    For i = 0 To UBound(handler.sc, 1)
+        sh.Cells(i + 1, 18) = handler.sc(i, 0)
+        sh.Cells(i + 1, 19) = handler.sc(i, 1)
+    Next i
+    
+    'basket
+    sh.Range("U1:AC100000").ClearContents
+    Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
+    Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
+    Sheets("config").Cells(5, 2) = 0
+    Sheets("config").Cells(6, 2) = 0
+    Sheets("config").Cells(7, 2) = 0
+    
+    months.load_sheet
+    
+    
+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
+
+
+Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Integer
+    Dim j As Integer
+    Dim res() As Variant
+    
+    If doc = "" Then
+        fail = True
+        Exit Function
+    End If
+    
+    server = Sheets("config").Cells(1, 2)
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/list_changes", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+    
+    Set json = JsonConverter.ParseJson(wr)
+    
+    If IsNull(json("x")) Then
+        MsgBox ("no history")
+        fail = True
+        Exit Function
+    End If
+    
+    ReDim res(json("x").Count - 1, 5)
+    
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("user")
+        res(i, 1) = json("x")(i + 1)("stamp")
+        res(i, 2) = json("x")(i + 1)("comment")
+        res(i, 3) = json("x")(i + 1)("sales")
+        res(i, 4) = json("x")(i + 1)("def")
+    Next i
+    
+    list_changes = res
+
+End Function
+
+Sub history()
+
+    changes.Show
+
+End Sub

login.frm

@@ -0,0 +1,35 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} login 
+   Caption         =   "CMS Login"
+   ClientHeight    =   2295
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   2445
+   OleObjectBlob   =   "login.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "login"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Public proceed As Boolean
+
+
+
+Private Sub cbCANCEL_Click()
+    tbU.Text = ""
+    tbP.Text = ""
+    proceed = False
+    Me.Hide
+End Sub
+
+Private Sub cbOK_Click()
+    proceed = True
+    Me.Hide
+End Sub
+
+
+Private Sub UserForm_Terminate()
+    proceed = False
+End Sub

months.cls

@@ -0,0 +1,963 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "months"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+Private x As New TheBigOne
+Private units() As Variant
+Private price() As Variant
+Private sales() As Variant
+Private tunits() As Variant
+Private tprice() As Variant
+Private tsales() As Variant
+Private dumping As Boolean
+Private vedit As String
+Private adjust() As Object
+Private jtext() As Variant
+Private basejson As Object
+Private rollback As Boolean
+Private scenario() As Variant
+Private orig As Range
+Private basket_touch As Range
+Private showbasket As Boolean
+Private np As Object 'json dedicated to new part scenario
+Private b() As Variant 'holds basket
+
+Private Sub Worksheet_Change(ByVal target As Range)
+
+    If Not dumping Then
+    
+        If Not Intersect(target, Range("A1:R18")) Is Nothing Then
+            If target.Columns.Count > 1 Then
+                MsgBox ("you can only change one column at a time - your change will be undone")
+                dumping = True
+                Application.Undo
+                dumping = False
+                Exit Sub
+            End If
+        End If
+        
+        If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
+        If Not Intersect(target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
+        If Not Intersect(target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
+        If Not Intersect(target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
+        If Not Intersect(target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
+        If Not Intersect(target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
+        
+        If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
+            Set basket_touch = target
+            Call Me.get_edit_basket
+            Set basket_touch = Nothing
+        End If
+        
+    End If
+End Sub
+
+Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
+
+
+    If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
+        cancel = True
+        Call Me.basket_pick(target)
+        target.Select
+    End If
+
+End Sub
+
+
+Sub picker_shortcut()
+    
+    If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
+        Call Me.basket_pick(Selection)
+    End If
+
+End Sub
+
+Private Sub Worksheet_BeforeRightClick(ByVal target As Range, cancel As Boolean)
+
+    If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
+        cancel = True
+        Call Me.basket_pick(target)
+        target.Select
+    End If
+
+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 mvp_set()
+
+    Dim i As Integer
+    Call Me.get_sheet
+
+    For i = 1 To 12
+        If units(i, 5) = "" Then units(i, 5) = 0
+        If price(i, 5) = "" Then price(i, 5) = 0
+        units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
+        price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
+        sales(i, 5) = units(i, 5) * price(i, 5)
+        If units(i, 4) = 0 And price(i, 4) = 0 Then
+            sales(i, 4) = 0
+        Else
+            sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
+        End If
+    Next i
+    
+    Me.crunch_array
+    Me.build_json
+    Me.set_sheet
+    
+        
+End Sub
+
+Sub mvp_adj()
+
+    Dim i As Integer
+    Call Me.get_sheet
+
+    For i = 1 To 12
+        If units(i, 4) = "" Then units(i, 4) = 0
+        If price(i, 4) = "" Then price(i, 4) = 0
+        units(i, 5) = units(i, 4) + (units(i, 2) + units(i, 3))
+        price(i, 5) = price(i, 4) + (price(i, 2) + price(i, 3))
+        sales(i, 5) = units(i, 5) * price(i, 5)
+        If units(i, 4) = 0 And price(i, 4) = 0 Then
+            sales(i, 4) = 0
+        Else
+            sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
+        End If
+    Next i
+    
+    Me.crunch_array
+    Me.build_json
+    Me.set_sheet
+    
+        
+End Sub
+
+Sub ms_set()
+
+On Error GoTo errh
+
+    Dim i As Integer
+    Call Me.get_sheet
+    Dim vp As String
+    vp = Sheets("month").Range("Q2")
+
+    For i = 1 To 12
+        If sales(i, 5) = "" Then sales(i, 5) = 0
+        If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 2) <> Round(sales(i, 4), 2) Then
+            sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
+            Select Case vp
+                Case "volume"
+                    If co_num(price(i, 5), 0) = 0 Then
+                        MsgBox ("price cannot be -0- and also have sales - your change will be undone")
+                        dumping = True
+                        Application.Undo
+                        dumping = False
+                        Exit Sub
+                    End If
+                    'reset price to original - delete these lines if a cascading effect is desired
+                    'price(i, 4) = 0
+                    'price(i, 5) = price(i, 2) + price(i, 3)
+                    'calc volume change on original price
+                    units(i, 5) = sales(i, 5) / price(i, 5)
+                    units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
+                Case "price"
+                    If co_num(units(i, 5), 0) = 0 Then
+                        MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
+                        dumping = True
+                        Application.Undo
+                        dumping = False
+                        Exit Sub
+                    End If
+                    price(i, 5) = sales(i, 5) / units(i, 5)
+                    price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
+                Case Else
+                    MsgBox ("error forcing sales with no offset specified - your change will be undone")
+                    dumping = True
+                    Application.Undo
+                    dumping = False
+                    Exit Sub
+            End Select
+        End If
+    Next i
+    
+    Me.crunch_array
+    Me.build_json
+    Me.set_sheet
+
+errh:
+    If Err.Number <> 0 Then rollback = True
+    
+        
+End Sub
+
+Sub ms_adj()
+
+    Dim i As Integer
+    Call Me.get_sheet
+    Dim vp As String
+    vp = Sheets("month").Range("Q2")
+
+    For i = 1 To 12
+        If sales(i, 4) = "" Then sales(i, 4) = 0
+        If Round(sales(i, 5), 6) <> Round(sales(i, 2) + sales(i, 3) + sales(i, 4), 6) Then
+            sales(i, 5) = sales(i, 4) + sales(i, 2) + sales(i, 3)
+            Select Case vp
+                Case "volume"
+                    If co_num(price(i, 5), 0) = 0 Then
+                        MsgBox ("price cannot be -0- and also have sales - your change will be undone")
+                        dumping = True
+                        Application.Undo
+                        dumping = False
+                        Exit Sub
+                    End If
+                    'reset price to original
+                    'price(i, 4) = 0
+                    'price(i, 5) = price(i, 2) + price(i, 3)
+                    'calc volume change on original price
+                    units(i, 5) = sales(i, 5) / price(i, 5)
+                    units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
+                Case "price"
+                    If co_num(units(i, 5), 0) = 0 Then
+                        MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
+                        dumping = True
+                        Application.Undo
+                        dumping = False
+                        Exit Sub
+                    End If
+                    price(i, 5) = sales(i, 5) / units(i, 5)
+                    price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
+                Case Else
+                    MsgBox ("error forcing sales with no offset specified - your change will be undone")
+                    dumping = True
+                    Application.Undo
+                    dumping = False
+                    Exit Sub
+            End Select
+        End If
+    Next i
+    
+    Me.crunch_array
+    Me.build_json
+    Me.set_sheet
+    
+        
+End Sub
+
+
+Sub get_sheet()
+
+    Dim i As Integer
+    
+    units = Range("B6:F17")
+    price = Range("H6:L17")
+    sales = Range("N6:R17")
+    tunits = Range("B18:F18")
+    tprice = Range("H18:L18")
+    tsales = Range("N18:R18")
+    ReDim adjust(12)
+    Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
+      
+End Sub
+
+Sub set_sheet()
+
+    Dim i As Integer
+
+    dumping = True
+    
+    Range("B6:F17") = units
+    Range("H6:L17") = price
+    Range("N6:R17") = sales
+    Range("B18:F18").FormulaR1C1 = tunits
+    Range("H18:L18").FormulaR1C1 = tprice
+    Range("N18:R18").FormulaR1C1 = tsales
+    Range("T6:U18").ClearContents
+    Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
+    'Sheets("month").Range("B32:Q5000").ClearContents
+    
+    If Me.newpart Then
+        Sheets("_month").Range("P2:P13").ClearContents
+        Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
+    Else
+        For i = 1 To 12
+            Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
+        Next i
+    End If
+    
+    dumping = False
+    
+End Sub
+
+Sub load_sheet()
+
+    units = Sheets("_month").Range("A2:E13").FormulaR1C1
+    price = Sheets("_month").Range("F2:J13").FormulaR1C1
+    sales = Sheets("_month").Range("K2:O13").FormulaR1C1
+    scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
+    tunits = Range("B18:F18")
+    tprice = Range("H18:L18")
+    tsales = Range("N18:R18")
+    'reset basket
+    Sheets("_month").Range("U1:X10000").ClearContents
+    Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
+    ReDim adjust(12)
+    Call Me.crunch_array
+    Call Me.set_sheet
+    Call Me.print_basket
+    Call Me.set_format
+    
+End Sub
+
+Sub set_format()
+
+    Dim prices As Range
+    Dim price_adj As Range
+    Dim price_set As Range
+    Dim vol As Range
+    Dim vol_adj As Range
+    Dim vol_set As Range
+    Dim val As Range
+    Dim val_adj As Range
+    Dim val_set As Range
+    
+    Set prices = Sheets("month").Range("H6:L17")
+    Set price_adj = Sheets("month").Range("K6:K17")
+    Set price_set = Sheets("month").Range("L6:L17")
+    
+    Set vol = Sheets("month").Range("B6:F17")
+    Set vol_adj = Sheets("month").Range("E6:E17")
+    Set vol_set = Sheets("month").Range("F6:F17")
+    
+    Set val = Sheets("month").Range("N6:R17")
+    Set val_adj = Sheets("month").Range("Q6:Q17")
+    Set val_set = Sheets("month").Range("R6:R17")
+    
+    Call Me.format_price(prices)
+    Call Me.set_border(prices)
+    Call Me.fill_yellow(price_adj)
+    Call Me.fill_none(price_set)
+    
+    Call Me.format_number(vol)
+    Call Me.set_border(vol)
+    Call Me.fill_yellow(vol_adj)
+    Call Me.fill_none(vol_set)
+    
+    Call Me.format_number(val)
+    Call Me.set_border(val)
+    Call Me.fill_yellow(val_adj)
+    Call Me.fill_none(val_set)
+    
+End Sub
+
+Sub set_border(ByRef targ As Range)
+
+    targ.Borders(xlDiagonalDown).LineStyle = xlNone
+    targ.Borders(xlDiagonalUp).LineStyle = xlNone
+    With targ.Borders(xlEdgeLeft)
+        .LineStyle = xlContinuous
+        .ColorIndex = 0
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+    With targ.Borders(xlEdgeTop)
+        .LineStyle = xlContinuous
+        .ColorIndex = 0
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+    With targ.Borders(xlEdgeBottom)
+        .LineStyle = xlContinuous
+        .ColorIndex = 0
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+    With targ.Borders(xlEdgeRight)
+        .LineStyle = xlContinuous
+        .ColorIndex = 0
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+    With targ.Borders(xlInsideVertical)
+        .LineStyle = xlContinuous
+        .ColorIndex = 0
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+    With targ.Borders(xlInsideHorizontal)
+        .LineStyle = xlContinuous
+        .ColorIndex = 0
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+
+End Sub
+
+Sub fill_yellow(ByRef target As Range)
+
+    With target.Interior
+        .Pattern = xlSolid
+        .PatternColorIndex = xlAutomatic
+        .ThemeColor = xlThemeColorAccent4
+        .TintAndShade = 0.799981688894314
+        .PatternTintAndShade = 0
+    End With
+
+End Sub
+
+Sub fill_grey(ByRef target As Range)
+
+
+    With target.Interior
+        .Pattern = xlSolid
+        .PatternColorIndex = xlAutomatic
+        .ThemeColor = xlThemeColorDark1
+        .TintAndShade = -0.149998474074526
+        .PatternTintAndShade = 0
+    End With
+    
+End Sub
+
+Sub fill_none(ByRef target As Range)
+
+    With target.Interior
+        .Pattern = xlNone
+        .TintAndShade = 0
+        .PatternTintAndShade = 0
+    End With
+    
+End Sub
+
+Sub format_price(ByRef target As Range)
+
+    target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
+
+End Sub
+
+Sub format_number(ByRef target As Range)
+
+    target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
+
+End Sub
+
+Sub build_json()
+
+    Dim i As Long
+    Dim j As Long
+    Dim pos As Long
+    Dim o As Object
+    Dim m As Object
+    Dim list As Object
+
+    ReDim handler.basis(100)
+    i = 2
+    j = 0
+    Do While Sheets("config").Cells(2, i) <> ""
+        handler.basis(j) = Sheets("config").Cells(2, i)
+        j = j + 1
+        i = i + 1
+    Loop
+    ReDim Preserve handler.basis(j - 1)
+    
+    ReDim adjust(12)
+    
+    If Me.newpart Then
+        Set np = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
+        np("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
+        np("user") = Application.UserName
+        np("scenario")("version") = "b20"
+        Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]")
+        np("source") = "adj"
+        np("type") = "new_basket"
+        Set m = JsonConverter.ParseJson("{}")
+    End If
+    
+    For pos = 1 To 12
+        If Me.newpart Then
+            If sales(pos, 5) <> 0 Then
+                Set o = JsonConverter.ParseJson("{}")
+                o("amount") = sales(pos, 5)
+                o("qty") = units(pos, 5)
+                Set m(Worksheets("month").Cells(5 + pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
+            End If
+        Else
+            'if something is changing
+            If Round(units(pos, 4), 2) <> 0 Or (Round(price(pos, 4), 8) <> 0 And Round(units(pos, 5), 2) <> 0) Then
+                Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
+                'if there is no existing volume on the target month but units are being added
+                If units(pos, 2) + units(pos, 3) = 0 And units(pos, 4) <> 0 Then
+                    'add month
+                    If Round(price(pos, 5), 8) <> Round(tprice(1, 2) + tprice(1, 3), 8) Then
+                        'if the target price is diferent from the average and a month is being added
+                        adjust(pos)("type") = "addmonth_vp"
+                    Else
+                        'if the target price is the same as average and a month is being added
+                        adjust(pos)("type") = "addmonth_v"
+                    End If
+                    adjust(pos)("month") = Worksheets("month").Cells(5 + pos, 1)
+                    adjust(pos)("qty") = units(pos, 4)
+                    adjust(pos)("amount") = sales(pos, 4)
+                Else
+                    'scale the existing volume(price) on the target month
+                    If Round(price(pos, 4), 8) <> 0 Then
+                        If Round(units(pos, 4), 2) <> 0 Then
+                            adjust(pos)("type") = "scale_vp"
+                        Else
+                            adjust(pos)("type") = "scale_p"
+                        End If
+                    Else
+                        'if the target price is the same as average and a month is being added
+                        adjust(pos)("type") = "scale_v"
+                    End If
+                    adjust(pos)("qty") = units(pos, 4)
+                    adjust(pos)("amount") = sales(pos, 4)
+                    '------------add this in to only scale a particular month--------------------
+                    adjust(pos)("scenario")("order_month") = Worksheets("month").Cells(5 + pos, 1)
+                End If
+                adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
+                adjust(pos)("user") = Application.UserName
+                adjust(pos)("scenario")("version") = "b20"
+                adjust(pos)("scenario")("iter") = handler.basis
+                adjust(pos)("source") = "adj"
+            End If
+        End If
+    Next pos
+    
+    If Me.newpart Then
+        Set np("months") = JsonConverter.ParseJson(JsonConverter.ConvertToJson(m))
+        np("newpart") = Worksheets("month").Range("B33").value
+        'np("basket") = x.json_from_table(b, "basket", False)
+        'get the basket from the sheet
+        b = Worksheets("_month").Range("U1").CurrentRegion.value
+        Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
+        If UBound(b, 1) <= 2 Then
+            Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
+        Else
+            Set np("basket") = m("basket")
+        End If
+    End If
+    
+    If Me.newpart Then
+        Sheets("_month").Range("P2:P13").ClearContents
+        Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
+    Else
+        For i = 1 To 12
+            Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
+        Next i
+    End If
+
+End Sub
+
+Sub crunch_array()
+
+    Dim i As Integer
+    Dim j As Integer
+    
+    For i = 1 To 5
+        tunits(1, i) = 0
+        tprice(1, i) = 0
+        tsales(1, i) = 0
+    Next i
+    
+    For i = 1 To 12
+        For j = 1 To 5
+            tunits(1, j) = tunits(1, j) + units(i, j)
+            tsales(1, j) = tsales(1, j) + sales(i, j)
+        Next j
+    Next i
+    
+    'prior
+    If tunits(1, 1) = 0 Then
+        tprice(1, 1) = 0
+    Else
+        tprice(1, 1) = tsales(1, 1) / tunits(1, 1)
+    End If
+    'base
+    If tunits(1, 2) = 0 Then
+        tprice(1, 2) = 0
+    Else
+        tprice(1, 2) = tsales(1, 2) / tunits(1, 2)
+    End If
+    'forecast
+    If tunits(1, 5) <> 0 Then
+        tprice(1, 5) = tsales(1, 5) / tunits(1, 5)
+    Else
+        tprice(1, 5) = 0
+    End If
+    'adjust
+    If (tunits(1, 2) + tunits(1, 3)) = 0 Then
+        tprice(1, 3) = 0
+    Else
+        tprice(1, 3) = (tsales(1, 2) + tsales(1, 3)) / (tunits(1, 2) + tunits(1, 3)) - tprice(1, 2)
+    End If
+    'current adjust
+    tprice(1, 4) = tprice(1, 5) - (tprice(1, 2) + tprice(1, 3))
+    
+
+End Sub
+
+Sub cancel()
+
+    Sheets("Orders").Select
+
+End Sub
+
+Sub reset()
+
+    
+    Call Me.load_sheet
+    
+End Sub
+
+Sub switch_basket()
+
+
+    If Sheets("config").Cells(6, 2) = 1 Then
+        Sheets("config").Cells(6, 2) = 0
+    Else
+        Sheets("config").Cells(6, 2) = 1
+    End If
+    
+    Call Me.print_basket
+    
+
+End Sub
+
+Sub print_basket()
+
+    'Sheets("config").Cells(6, 2) = 1
+    If Sheets("config").Cells(6, 2) = 0 Then
+        dumping = True
+        Worksheets("month").Range("B32:Q10000").ClearContents
+        Rows("20:31").Hidden = False
+        dumping = False
+        Exit Sub
+    End If
+
+    Dim i As Long
+    Dim basket() As Variant
+    basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
+    
+    dumping = True
+    
+    Worksheets("month").Range("B32:Q10000").ClearContents
+    For i = 1 To UBound(basket, 1)
+        Sheets("month").Cells(31 + i, 2) = basket(i, 1)
+        Sheets("month").Cells(31 + i, 6) = basket(i, 2)
+        Sheets("month").Cells(31 + i, 12) = basket(i, 3)
+        Sheets("month").Cells(31 + i, 17) = basket(i, 4)
+    Next i
+    
+    Rows("20:31").Hidden = True
+    
+    dumping = False
+
+End Sub
+
+
+Sub basket_pick(ByRef target As Range)
+    
+        Dim i As Long
+        
+
+        build.part = Sheets("month").Cells(target.row, 2)
+        build.bill = rev_cust(Sheets("month").Cells(target.row, 6))
+        build.ship = rev_cust(Sheets("month").Cells(target.row, 12))
+        build.useval = False
+        build.Show
+        
+        If build.useval Then
+            dumping = True
+            'if an empty row is selected, force it to be the next open slot
+            If Sheets("month").Cells(target.row, 2) = "" Then
+                Do Until Sheets("month").Cells(target.row + i, 2) <> ""
+                    i = i - 1
+                Loop
+                i = i + 1
+            End If
+            
+            
+            Sheets("month").Cells(target.row + i, 2) = build.cbPart.value
+            Sheets("month").Cells(target.row + i, 6) = rev_cust(build.cbBill.value)
+            Sheets("month").Cells(target.row + i, 12) = rev_cust(build.cbShip.value)
+            dumping = False
+            Set basket_touch = Selection
+            Call Me.get_edit_basket
+            Set basket_touch = Nothing
+            
+        End If
+        target.Select
+        
+    
+End Sub
+
+Sub get_edit_basket()
+    
+    Dim i As Long
+    Dim mix As Double
+    Dim touch_mix As Double
+    Dim untouched As Long
+    Dim touch() As Boolean
+    
+    'ReDim b(basket_rows, 3)
+    
+    i = 0
+    Do Until Worksheets("month").Cells(33 + i, 2) = ""
+        i = i + 1
+    Loop
+    i = i - 1
+    
+    ReDim b(i, 3)
+    ReDim touch(i)
+    untouched = i + 1
+    
+    i = 0
+    mix = 0
+    Do Until Worksheets("month").Cells(33 + i, 2) = ""
+        b(i, 0) = Worksheets("month").Cells(33 + i, 2)
+        b(i, 1) = Worksheets("month").Cells(33 + i, 6)
+        b(i, 2) = Worksheets("month").Cells(33 + i, 12)
+        b(i, 3) = Worksheets("month").Cells(33 + i, 17)
+        If b(i, 3) = "" Then b(i, 3) = 0
+        mix = mix + b(i, 3)
+        If Not Intersect(basket_touch, Worksheets("month").Cells(33 + i, 17)) Is Nothing Then
+            touch_mix = touch_mix + b(i, 3)
+            touch(i) = True
+            untouched = untouched - 1
+        End If
+        i = i + 1
+    Loop
+    
+    'evaluate mix changes and force to 100
+    For i = 0 To UBound(b, 1)
+        If Not touch(i) Then
+            If mix - touch_mix = 0 Then
+                b(i, 3) = (1 - mix) / untouched
+            Else
+                b(i, 3) = b(i, 3) + b(i, 3) * (1 - mix) / (mix - touch_mix)
+            End If
+        End If
+    Next i
+    
+    dumping = True
+    
+    'put the mix plug back on the the sheet
+    For i = 0 To UBound(b, 1)
+        Worksheets("month").Cells(33 + i, 17) = b(i, 3)
+    Next i
+    
+    dumping = False
+    
+    Worksheets("_month").Range("U2:X5000").ClearContents
+    Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
+    
+    If Me.newpart Then
+        Me.build_json
+    End If
+    
+    
+    
+
+End Sub
+
+
+Sub post_adjust()
+    
+    Dim i As Long
+    Dim fail As Boolean
+    
+    If Me.newpart Then
+        Call handler.request_adjust(Sheets("_month").Cells(2, 16), fail)
+        If fail Then Exit Sub
+    Else
+        For i = 2 To 13
+            If Sheets("_month").Cells(i, 16) <> "" Then
+                Call handler.request_adjust(Sheets("_month").Cells(i, 16), fail)
+                If fail Then Exit Sub
+            End If
+        Next i
+    End If
+    
+    Sheets("Orders").Select
+    'Worksheets("month").Visible = xlHidden
+
+End Sub
+
+Sub build_new()
+
+    Worksheets("config").Cells(5, 2) = 1
+    Dim i As Long
+    Dim j As Long
+    Dim basket() As Variant
+    Dim m() As Variant
+
+    dumping = True
+    
+    m = Sheets("_month").Range("A2:O13").FormulaR1C1
+    
+    For i = 1 To UBound(m, 1)
+        For j = 1 To UBound(m, 2)
+            m(i, j) = 0
+        Next j
+    Next i
+    
+    Worksheets("_month").Range("A2:O13") = m
+    
+    Worksheets("_month").Range("U2:X1000").ClearContents
+    Worksheets("_month").Range("Z2:AC1000").ClearContents
+    Worksheets("_month").Range("R2:S1000").ClearContents
+    Call Me.load_sheet
+    'Call Me.set_sheet
+    'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
+    
+    basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
+    Sheets("month").Cells(32, 2) = basket(1, 1)
+    Sheets("month").Cells(32, 6) = basket(1, 2)
+    Sheets("month").Cells(32, 12) = basket(1, 3)
+    Sheets("month").Cells(32, 17) = basket(1, 4)
+    Call Me.print_basket
+
+    dumping = False
+
+End Sub
+
+Sub new_part()
+
+    'keep customer mix
+    'add in new part number
+    'retain to _month
+    'set new part flag
+    
+    Dim cust() As String
+    Dim i As Long
+    
+    '---------build customer mix-------------------------------------------------------------------
+    
+    cust = x.SHTp_Get("_month", 1, 27, True)
+    If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
+        MsgBox ("error building customer mix")
+    End If
+    
+    '--------inquire for new part to join with cust mix--------------------------------------------
+    
+    part.Show
+    
+    If Not part.useval Then
+        Exit Sub
+    End If
+    
+    dumping = True
+    
+    Worksheets("month").Range("B33:Q10000").ClearContents
+    
+    For i = 1 To UBound(cust, 2)
+        Sheets("month").Cells(32 + i, 2) = part.cbPart.value
+        Sheets("month").Cells(32 + i, 6) = cust(0, i)
+        Sheets("month").Cells(32 + i, 12) = cust(1, i)
+        Sheets("month").Cells(32 + i, 17) = CDbl(cust(2, i))
+    Next i
+    
+    Sheets("config").Cells(7, 2) = 1
+    
+    '------copy revised basket to _month storage---------------------------------------------------
+    
+    i = 0
+    Do Until Worksheets("month").Cells(33 + i, 2) = ""
+        i = i + 1
+    Loop
+    i = i - 1
+    If i = -1 Then i = 0
+    ReDim b(i, 3)
+    i = 0
+    Do Until Worksheets("month").Cells(33 + i, 2) = ""
+        b(i, 0) = Worksheets("month").Cells(33 + i, 2)
+        b(i, 1) = Worksheets("month").Cells(33 + i, 6)
+        b(i, 2) = Worksheets("month").Cells(33 + i, 12)
+        b(i, 3) = Worksheets("month").Cells(33 + i, 17)
+        If b(i, 3) = "" Then b(i, 3) = 0
+        i = i + 1
+    Loop
+    Worksheets("_month").Range("U2:AC10000").ClearContents
+    Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
+    Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
+    
+    '------reset volume to copy base to forecsat and clear base------------------------------------
+    
+    units = Sheets("_month").Range("A2:E13").FormulaR1C1
+    price = Sheets("_month").Range("F2:J13").FormulaR1C1
+    sales = Sheets("_month").Range("K2:O13").FormulaR1C1
+    tunits = Range("B18:F18")
+    tprice = Range("H18:L18")
+    tsales = Range("N18:R18")
+    ReDim adjust(12)
+    Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
+    For i = 1 To 12
+        'volume
+        units(i, 5) = units(i, 2)
+        units(i, 4) = units(i, 2)
+        units(i, 1) = 0
+        units(i, 2) = 0
+        units(i, 3) = 0
+        'sales
+        sales(i, 5) = sales(i, 2)
+        sales(i, 4) = sales(i, 2)
+        sales(i, 1) = 0
+        sales(i, 2) = 0
+        sales(i, 3) = 0
+        'price
+        price(i, 5) = price(i, 2)
+        price(i, 4) = price(i, 2)
+        price(i, 1) = 0
+        price(i, 2) = 0
+        price(i, 3) = 0
+    Next i
+    Call Me.crunch_array
+    Call Me.build_json
+    Call Me.set_sheet
+    
+    '-------------push revised arrays back to _month, not revertable-------------------------------
+    
+    Worksheets("_month").Range("A2:E13") = units
+    Worksheets("_month").Range("F2:J13") = price
+    Worksheets("_month").Range("K2:o13") = sales
+    
+    
+    'force basket to show to demonstrate the part was changed
+    Sheets("config").Cells(6, 2) = 1
+    Call Me.print_basket
+    dumping = False
+    
+End Sub
+
+Function newpart() As Boolean
+
+    If Worksheets("config").Cells(7, 2) = 1 Then
+        newpart = True
+    Else
+        newpart = False
+    End If
+    
+End Function
+
+

openf.frm

@@ -0,0 +1,51 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf 
+   Caption         =   "Open a Forecast"
+   ClientHeight    =   2025
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   3825
+   OleObjectBlob   =   "openf.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "openf"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Private Sub cbCancel_Click()
+    
+    openf.Hide
+    
+End Sub
+
+Private Sub cbOK_Click()
+
+    Application.StatusBar = "Retrieving data for " & cbDSM.value & "....."
+
+    openf.Caption = "retrieving data......"
+    Call handler.pg_main_workset(cbDSM.value)
+    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    Application.StatusBar = False
+    openf.Hide
+
+End Sub
+
+Private Sub UserForm_Activate()
+
+    'handler.server = "http://192.168.1.69:3000"
+    handler.server = Sheets("config").Cells(1, 2)
+
+    Dim x As New TheBigOne
+    Dim d() As String
+    
+    openf.Caption = "Select a DSM"
+    d = x.SHTp_Get("reps", 1, 1, True)
+    
+    For i = 1 To UBound(d, 2)
+        Call cbDSM.AddItem(d(0, i))
+    Next i
+
+
+End Sub
+

part.frm

@@ -0,0 +1,48 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part 
+   Caption         =   "Part Picker"
+   ClientHeight    =   1080
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   8100
+   OleObjectBlob   =   "part.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "part"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+
+Public part As String
+Public bill As String
+Public ship As String
+Public useval As Boolean
+Option Explicit
+
+
+Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+
+    Select Case KeyCode
+        Case 13
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+
+End Sub
+
+
+
+Private Sub UserForm_Activate()
+    
+    useval = False
+    
+    cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
+    
+
+End Sub
+
+

pivot.bas

@@ -0,0 +1,107 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "pivot"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
+
+    If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
+        Exit Sub
+    End If
+    
+    On Error GoTo nopiv
+    
+    If Target.Cells.PivotTable Is Nothing Then
+        Exit Sub
+    End If
+
+    Cancel = True
+
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+    
+    Dim ri As PivotItemList
+    Dim ci As PivotItemList
+    Dim df As Object
+    Dim rd As Object
+    Dim cd As Object
+    Dim dd As Object
+    
+    Dim pt As PivotTable
+    Dim pf As PivotField
+    Dim pi As PivotItem
+    Dim wapi As New Windows_API
+    
+    Set ri = Target.Cells.PivotCell.RowItems
+    Set ci = Target.Cells.PivotCell.ColumnItems
+    Set df = Target.Cells.PivotCell.DataField
+
+    Set rd = Target.Cells.PivotTable.RowFields
+    Set cd = Target.Cells.PivotTable.ColumnFields
+    
+
+    ReDim handler.sc(ri.Count, 1)
+    Set pt = Target.Cells.PivotCell.PivotTable
+    
+    handler.sql = ""
+    handler.jsql = ""
+
+    For i = 1 To ri.Count
+        If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
+        If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
+        handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & ri(i).Name & "'"
+        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """"
+        handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
+        handler.sc(i - 1, 1) = ri(i).Name
+    Next i
+    
+    
+    scenario = "{" & handler.jsql & "}"
+    
+    Call handler.load_config
+    Call handler.load_fpvt
+    
+    
+nopiv:
+
+End Sub
+
+Function piv_pos(list As Object, target_pos As Long) As Long
+
+    Dim i As Long
+    
+    For i = 1 To list.Count
+        If list(i).Position = target_pos Then
+            piv_pos = i
+            Exit Function
+        End If
+    Next i
+    'should not get to this point
+
+End Function
+
+Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
+
+    Dim i As Integer
+    
+    For i = 1 To pt.PivotFields.Count
+        If pt.PivotFields(i).Name = field_name Then
+            piv_fld_index = i
+            Exit Function
+        End If
+    Next i
+
+End Function
+
+
+
+
+
+

pivot.cls

@@ -0,0 +1,113 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "pivot"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
+
+    If Intersect(target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
+        Exit Sub
+    End If
+
+    On Error GoTo nopiv
+
+    If target.Cells.PivotTable Is Nothing Then
+        Exit Sub
+    End If
+
+    cancel = True
+
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+    
+    Dim ri As PivotItemList
+    Dim ci As PivotItemList
+    Dim df As Object
+    Dim rd As Object
+    Dim cd As Object
+    Dim dd As Object
+    
+    Dim pt As PivotTable
+    Dim pf As PivotField
+    Dim pi As PivotItem
+    Dim wapi As New Windows_API
+    
+    Set ri = target.Cells.PivotCell.RowItems
+    Set ci = target.Cells.PivotCell.ColumnItems
+    Set df = target.Cells.PivotCell.DataField
+
+    Set rd = target.Cells.PivotTable.RowFields
+    Set cd = target.Cells.PivotTable.ColumnFields
+    
+    ReDim handler.sc(ri.Count, 1)
+    Set pt = target.Cells.PivotCell.PivotTable
+    
+    handler.sql = ""
+    handler.jsql = ""
+
+    For i = 1 To ri.Count
+        If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
+        If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
+        handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape(ri(i).Name) & "'"
+        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape(ri(i).Name) & """"
+        handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
+        handler.sc(i - 1, 1) = ri(i).Name
+    Next i
+    
+    scenario = "{" & handler.jsql & "}"
+    
+    Call handler.load_config
+    Call handler.load_fpvt
+    
+nopiv:
+
+End Sub
+
+Function piv_pos(list As Object, target_pos As Long) As Long
+
+    Dim i As Long
+    
+    For i = 1 To list.Count
+        If list(i).Position = target_pos Then
+            piv_pos = i
+            Exit Function
+        End If
+    Next i
+    'should not get to this point
+
+End Function
+
+Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
+
+    Dim i As Integer
+    
+    For i = 1 To pt.PivotFields.Count
+        If pt.PivotFields(i).Name = field_name Then
+            piv_fld_index = i
+            Exit Function
+        End If
+    Next i
+
+End Function
+
+Function escape(ByVal text As String) As String
+
+    text = Replace(text, "'", "''")
+    text = Replace(text, """", """""")
+    If text = "(blank)" Then text = ""
+    escape = text
+
+End Function
+
+
+
+
+
+

pricelist.frm

@@ -0,0 +1,48 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist 
+   Caption         =   "Price List Name"
+   ClientHeight    =   5115
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   4110
+   OleObjectBlob   =   "pricelist.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "pricelist"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Public proceed As Boolean
+
+Private Sub bCANCEL_Click()
+    proceed = False
+    Me.Hide
+End Sub
+
+Private Sub bOK_Click()
+    proceed = True
+    Me.Hide
+End Sub
+
+
+Private Sub bPICK_Click()
+
+    '--------Open file-------------
+    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
+    fd.Show
+    
+    tbPATH.Text = fd.SelectedItems(1)
+
+
+End Sub
+
+Private Sub UserForm_Initialize()
+    proceed = False
+End Sub
+
+Private Sub UserForm_Terminate()
+    proceed = False
+End Sub
+
+