Save the exported VBA code in the repo. This is its initial commit.

Master Template.xlsm_EXPORTS/JsonDebugPrint.bas

@@ -0,0 +1,43 @@
+Attribute VB_Name = "JsonDebugPrint"
+Option Explicit
+
+
+Public Sub TestPrintJSON()
+    PrintJSON ParseJson("[1,2,3]")
+    PrintJSON ParseJson("[{""a"":123,""b"":[56,7,78]}]")
+End Sub
+
+' This is definitely NOT a pretty printer. It was written merely as a debugging
+' tool to make sense of the objects that come out of JsonConverter.ParseJSON.
+' It doesn't format in the best way possible, but it does provide a semi-readable
+' view of the data in the JSON object.
+'                                               Phil Runninger 3/1/2023
+'
+Public Sub PrintJSON(obj As Variant, Optional level As Integer = 0)
+    Dim itm As Variant
+    Dim first As Boolean
+    Select Case TypeName(obj)
+        Case "Dictionary"
+            Debug.Print String(level * 2, " "); "{"
+            first = True
+            For Each itm In obj
+                If Not first Then Debug.Print String((level + 1) * 2, " "); ","
+                first = False
+                Debug.Print String((level + 1) * 2, " "); itm; ":";
+                PrintJSON obj(itm), level + 1
+            Next
+            Debug.Print String(level * 2, " "); "}"
+        Case "Collection"
+            Debug.Print String(level * 2, " "); "["
+            first = True
+            For Each itm In obj
+                If Not first Then Debug.Print String(level * 2, " "); ","
+                first = False
+                PrintJSON itm, level + 1
+            Next
+            Debug.Print String(level * 2, " "); "]"
+        Case Else
+            Debug.Print String(level * 2, " "); obj;
+    End Select
+End Sub
+

Master Template.xlsm_EXPORTS/ThisWorkbook.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ThisWorkbook"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

Master Template.xlsm_EXPORTS/Utils.bas

@@ -0,0 +1,620 @@
+Attribute VB_Name = "Utils"
+Option Explicit
+
+Public ADOo_errstring As String
+
+Public Function TBLp_Aggregate(ByRef tbl() As String, ByRef needsort As Boolean, ByRef headers As Boolean, ByRef del_unused As Boolean, ParamArray groupnum_type_sumnum()) As Boolean
+
+    Dim i As Long
+    Dim j As Long
+    Dim nt() As String
+    Dim keep() As Integer
+
+    If needsort Then
+        If Not TBLp_BubbleSortAsc(tbl, PAp_2DGetIntegerArray(0, groupnum_type_sumnum), PAp_2DGetStringArray(1, groupnum_type_sumnum), headers) Then
+            TBLp_Aggregate = False
+            Exit Function
+        End If
+    End If
+
+    If Not TBLp_Roll(tbl, PAp_2DGetIntegerArray(0, groupnum_type_sumnum), PAp_2DGetIntegerArray(2, groupnum_type_sumnum), headers) Then
+        TBLp_Aggregate = False
+        Exit Function
+    End If
+
+
+    If del_unused Then
+        keep = PAp_2DGetMultIntegerArray(ARRAYp_MakeInteger(0, 2), groupnum_type_sumnum)
+        ReDim nt(UBound(keep()), UBound(tbl, 2))
+        For i = 0 To UBound(keep())
+            For j = 0 To UBound(tbl, 2)
+                nt(i, j) = tbl(keep(i), j)
+            Next j
+        Next i
+        tbl = nt
+    End If
+
+    TBLp_Aggregate = True
+
+End Function
+
+Function TBLp_BubbleSortAsc(ByRef tbl() As String, ByRef sortflds() As Integer, ByRef typeflds() As String, ByRef headers As Boolean) As Boolean
+
+On Error GoTo errh
+    'get fort field numbers
+    'loop through each row and generate the row key
+    'eveluate the row key against other row keys
+    'perform swaps
+
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+
+    k = 0
+    If headers Then k = 1
+
+    For i = k To UBound(tbl, 2) - 1
+        For j = i + 1 To UBound(tbl, 2)
+            If ROWe_AscSwapFlag(tbl, i, j, sortflds, typeflds) Then
+                Call ROWp_Swap(tbl, i, j)
+            Else
+                If ADOo_errstring <> "" Then
+                    TBLp_BubbleSortAsc = False
+                    Exit Function
+                End If
+            End If
+        Next j
+    Next i
+
+errh:
+    If Err.Number <> 0 Then
+        MsgBox ("Error at TBLP_BubbleSortAsc." & vbCrLf & Err.Description)
+        ADOo_errstring = Err.Description
+    End If
+
+    TBLp_BubbleSortAsc = True
+
+End Function
+
+Public Function TBLp_Roll(ByRef tbl() As String, ByRef gflds() As Integer, ByRef sflds() As Integer, ByRef headers As Boolean) As Boolean
+
+On Error GoTo errh
+    Dim i As Long 'indexes primary row
+    Dim j As Long 'indexes secondary chaecker row
+    Dim k As Integer 'used to start at 0 or 1
+    Dim m As Long 'used to aggregate on sequencing lines (i and j aggregate to m line) then shorten array to m length - 1
+
+    k = 0
+    If headers Then k = 1
+    m = k
+    For i = k To UBound(tbl, 2)
+        If i = UBound(tbl, 2) Then
+            i = i
+        End If
+        j = i + 1
+        Do
+            If j > UBound(tbl, 2) Then Exit Do
+            If ROWe_MatchesFlag(tbl, i, j, gflds) Then
+                Call ROWp_Aggregate2Rows(tbl, i, j, sflds)
+            Else
+                Exit Do
+            End If
+            j = j + 1
+            If j > UBound(tbl, 2) Then
+                Exit Do
+            End If
+        Loop
+        Call ROWp_Copy(tbl, i, m)
+        m = m + 1
+        i = j - 1
+    Next i
+
+    ReDim Preserve tbl(UBound(tbl, 1), m - 1)
+
+errh:
+    If Err.Number <> 0 Then
+        ADOo_errstring = Err.Description
+        TBLp_Roll = False
+        Exit Function
+    End If
+
+    TBLp_Roll = True
+
+End Function
+
+Sub ROWp_Swap(ByRef tbl() As String, ByRef p1 As Long, ByRef p2 As Long)
+
+    Dim temprow() As String
+    ReDim temprow(UBound(tbl, 1))
+    Dim i As Integer
+
+    For i = 0 To UBound(tbl, 1)
+        temprow(i) = tbl(i, p2)
+    Next i
+
+    For i = 0 To UBound(tbl, 1)
+        tbl(i, p2) = tbl(i, p1)
+    Next i
+
+    For i = 0 To UBound(tbl, 1)
+        tbl(i, p1) = temprow(i)
+    Next i
+
+End Sub
+
+Sub ROWp_Copy(ByRef tbl() As String, ByRef r_from As Long, ByRef r_to As Long)
+
+    Dim i As Integer
+
+    For i = 0 To UBound(tbl, 1)
+        tbl(i, r_to) = tbl(i, r_from)
+    Next i
+
+End Sub
+
+Sub ROWp_Aggregate2Rows(ByRef tbl() As String, ByRef p1 As Long, ByRef p2 As Long, ByRef sflds() As Integer)
+
+    Dim i As Integer
+    On Error GoTo exitsub
+    For i = 0 To UBound(sflds, 1)
+        tbl(sflds(i), p1) = CDbl(tbl(sflds(i), p1)) + CDbl(tbl(sflds(i), p2))
+    Next i
+
+exitsub:
+
+End Sub
+
+Function ROWe_AscSwapFlag(ByRef tbl() As String, ByRef row1 As Long, ByRef row2 As Long, ByRef KeyFld() As Integer, ByRef TypeFld() As String) As Boolean
+    'only returns true if greater than
+
+On Error GoTo errh
+    Dim i As Integer
+    Dim compare As Integer
+
+    For i = 0 To UBound(KeyFld)
+        Select Case TypeFld(i)
+            Case "S"
+                compare = MISCe_CompareString(CStr(tbl(KeyFld(i), row1)), CStr(tbl(KeyFld(i), row2)))
+            Case "N"
+                compare = MISCe_CompareDouble(CDbl(tbl(KeyFld(i), row1)), CDbl(tbl(KeyFld(i), row2)))
+            Case "D"
+                compare = MISCe_CompareDate(CDate(tbl(KeyFld(i), row1)), CDate(tbl(KeyFld(i), row2)))
+        End Select
+        Select Case compare
+            Case -1
+                ROWe_AscSwapFlag = True
+                Exit Function
+            Case 1
+                ROWe_AscSwapFlag = False
+                Exit Function
+        End Select
+    Next i
+
+errh:
+    If Err.Number <> 0 Then
+        MsgBox ("Error at ROWe_AscSwapFlag." & vbCrLf & Err.Description)
+        ADOo_errstring = Err.Description
+        Exit Function
+    End If
+
+End Function
+
+Function ROWe_MatchesFlag(ByRef tbl() As String, ByRef row1 As Long, ByRef row2 As Long, ByRef KeyFld() As Integer) As Boolean
+    'only returns true if greater than
+
+    Dim i As Integer
+    Dim k1 As String
+    Dim k2 As String
+
+    For i = 0 To UBound(KeyFld())
+        k1 = k1 & tbl(KeyFld(i), row1)
+    Next i
+
+    For i = 0 To UBound(KeyFld())
+        k2 = k2 & tbl(KeyFld(i), row2)
+    Next i
+
+
+    If k2 = k1 Then
+        ROWe_MatchesFlag = True
+    Else
+        ROWe_MatchesFlag = False
+    End If
+
+End Function
+
+Sub SHTp_DumpVar(ByRef tbl() As Variant, ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef clear As Boolean, ByRef transpose As Boolean, ByRef zerobase As Boolean)
+
+    Dim sh As Worksheet
+    Dim address As String
+    Set sh = Sheets(sheet)
+
+    'If clear Then sh.Cells.clear
+    'If transpose Then Call ARRAYp_Transpose(tbl)
+    If zerobase Then
+        address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).address
+    Else
+        address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1) - 1, col + UBound(tbl, 2) - 1).address
+    End If
+    sh.Range(address).FormulaR1C1 = tbl
+
+    On Error GoTo errhndl
+
+
+errhndl:
+    If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
+
+
+End Sub
+
+Function ARRAYp_TransposeVar(ByRef a() As Variant) As Variant()
+
+    Dim s() As Variant
+    ReDim s(UBound(a, 2), UBound(a, 1))
+
+    Dim i As Long
+    Dim j As Long
+
+    For i = 0 To UBound(s, 1)
+        For j = 0 To UBound(s, 2)
+            s(i, j) = a(j, i)
+        Next j
+    Next i
+
+    ARRAYp_TransposeVar = s
+
+End Function
+
+Function ARRAYp_zerobased_addheader(ByRef z() As Variant, ParamArray cols()) As Variant()
+
+    Dim i As Long
+    Dim j As Long
+
+    Dim r() As Variant
+    ReDim r(UBound(z, 1), UBound(z, 2) + 1)
+
+    For i = 0 To UBound(r, 1)
+        For j = 1 To UBound(r, 2)
+            r(i, j) = z(i, j - 1)
+        Next j
+        r(i, 0) = cols(i)
+    Next i
+
+    ARRAYp_zerobased_addheader = r
+
+End Function
+
+Public Function SHTp_Get(ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef headers As Boolean) As String()
+
+    Dim i As Long
+    Dim j As Long
+    Dim table() As String
+    Dim sh As Worksheet
+    Set sh = Sheets(sheet)
+
+    On Error GoTo errhdnl
+
+    i = 1
+    While sh.Cells(row, col + i - 1) <> ""
+        i = i + 1
+    Wend
+
+    j = 1
+    While sh.Cells(row + j - 1, col) <> ""
+        j = j + 1
+    Wend
+
+    ReDim table(i - 2, j - 2)
+    i = 1
+    While i <= UBound(table, 1) + 1
+        j = 0
+        While j <= UBound(table, 2)
+            table(i - 1, j) = sh.Cells(row + j, col + i - 1)
+            j = j + 1
+        Wend
+        i = i + 1
+    Wend
+
+errhdnl:
+    If Err.Number <> 0 Then
+        MsgBox (Err.Description)
+    End If
+
+    SHTp_Get = table
+
+End Function
+
+Function PAp_2DGetStringArray(ByRef index As Integer, ParamArray pa()) As String()
+
+    Dim str() As String
+    Dim i As Long
+    ReDim str(UBound(pa(0)(index)))
+
+    For i = 0 To UBound(pa(0)(index))
+        str(i) = pa(0)(index)(i)
+    Next i
+    PAp_2DGetStringArray = str
+
+End Function
+
+Function PAp_2DGetIntegerArray(ByRef index As Integer, ParamArray pa()) As Integer()
+
+    Dim str() As Integer
+    Dim i As Long
+    If UBound(pa(0)(index)) <> -1 Then
+        ReDim str(UBound(pa(0)(index)))
+
+        For i = 0 To UBound(pa(0)(index))
+            str(i) = pa(0)(index)(i)
+        Next i
+    End If
+    PAp_2DGetIntegerArray = str
+
+End Function
+
+Function PAp_2DGetMultIntegerArray(ByRef ArraysGet() As Integer, ParamArray pa()) As Integer()
+
+    Dim str() As Integer
+    Dim i As Long
+    Dim j As Long
+    Dim cnt As Long
+    Dim index As Long
+
+
+    'get length of selected arrays
+    For i = 0 To UBound(ArraysGet, 1)
+        cnt = cnt + UBound(pa(0)(ArraysGet(i)))
+    Next i
+
+    ReDim str(cnt + 1)
+    cnt = 0
+
+    For i = 0 To UBound(ArraysGet, 1)
+        For j = 0 To UBound(pa(0)(ArraysGet(i)))
+            str(cnt) = pa(0)(ArraysGet(i))(j)
+            cnt = cnt + 1
+        Next j
+    Next i
+
+    PAp_2DGetMultIntegerArray = str
+
+End Function
+
+Public Function ARRAYp_MakeInteger(ParamArray items()) As Integer()
+
+    Dim X() As Integer
+    Dim i As Integer
+    ReDim X(UBound(items))
+
+    For i = 0 To UBound(items())
+        X(i) = items(i)
+    Next i
+
+    ARRAYp_MakeInteger = X
+
+End Function
+
+Public Function MISCe_CompareString(ByRef base As String, ByRef compare As String) As Integer
+
+    If compare < base Then
+        MISCe_CompareString = -1
+        Exit Function
+    End If
+
+    If compare = base Then
+        MISCe_CompareString = 0
+        Exit Function
+    End If
+
+    If compare > base Then
+        MISCe_CompareString = 1
+        Exit Function
+    End If
+
+End Function
+
+Public Function MISCe_CompareDouble(ByRef base As Double, ByRef compare As Double) As Integer
+
+    If compare < base Then
+        MISCe_CompareDouble = -1
+        Exit Function
+    End If
+
+    If compare = base Then
+        MISCe_CompareDouble = 0
+        Exit Function
+    End If
+
+    If compare > base Then
+        MISCe_CompareDouble = 1
+        Exit Function
+    End If
+
+End Function
+
+Public Function MISCe_CompareDate(ByRef base As Date, ByRef compare As Date) As Integer
+
+
+    If compare < base Then
+        MISCe_CompareDate = -1
+        Exit Function
+    End If
+
+    If compare = base Then
+        MISCe_CompareDate = 0
+        Exit Function
+    End If
+
+    If compare > base Then
+        MISCe_CompareDate = 1
+        Exit Function
+    End If
+
+End Function
+
+Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
+
+
+    Dim ajson As String
+    Dim json As String
+    Dim r As Integer
+    Dim c As Integer
+    Dim needs_comma As Boolean
+    Dim needs_braces As Integer
+
+    needs_comma = False
+    needs_braces = 0
+    ajson = ""
+
+    For r = 2 To UBound(tbl, 1)
+        For c = 1 To UBound(tbl, 2)
+            If tbl(r, c) <> "" Then
+                needs_braces = needs_braces + 1
+                If needs_comma Then json = json & ","
+                needs_comma = True
+                If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
+                    json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & tbl(r, c)
+                Else
+                    'test if item is a json object
+                    If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
+                        json = json & """" & tbl(1, c) & """" & ":" & tbl(r, c)
+                    Else
+                        json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
+                    End If
+                End If
+            End If
+        Next c
+        If needs_braces > 0 Then json = "{" & json & "}"
+        needs_comma = False
+        needs_braces = 0
+        If r > 2 Then
+            ajson = ajson & "," & json
+        Else
+            ajson = json
+        End If
+        json = ""
+    Next r
+
+    'if theres more the one record, include brackets for array
+    'if an array_label is given give the array a key and the array become the value
+    'then if the array is labeled with a key it should have braces unless specified otherwise
+    If r > 3 Then
+        ajson = "[" & ajson & "]"
+        If array_label <> "" Then
+            ajson = """" & array_label & """:" & ajson
+            If Not strip_braces Then
+                ajson = "{" & ajson & "}"
+            End If
+        End If
+    Else
+        If strip_braces Then
+            ajson = Mid(ajson, 2, Len(ajson) - 2)
+        End If
+    End If
+
+    json_from_table = ajson
+
+End Function
+
+Public Function json_from_table_zb(ByRef tbl() As Variant, ByRef array_label As String, ByVal force_array As Boolean, Optional strip_braces As Boolean) As String
+
+    Dim ajson As String
+    Dim json As String
+    Dim r As Integer
+    Dim c As Integer
+    Dim needs_comma As Boolean
+    Dim needs_braces As Integer
+
+    needs_comma = False
+    needs_braces = 0
+    ajson = ""
+
+    For r = 1 To UBound(tbl, 1)
+        For c = 0 To UBound(tbl, 2)
+            If tbl(r, c) <> "" Then
+                needs_braces = needs_braces + 1
+                If needs_comma Then json = json & ","
+                needs_comma = True
+                If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
+                    json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & tbl(r, c)
+                Else
+                    'test if item is a json object
+                    If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
+                        json = json & """" & tbl(0, c) & """" & ":" & tbl(r, c)
+                    Else
+                        json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
+                    End If
+                End If
+            End If
+        Next c
+        If needs_braces > 0 Then json = "{" & json & "}"
+        needs_comma = False
+        needs_braces = 0
+        If r > 1 Then
+            ajson = ajson & "," & json
+        Else
+            ajson = json
+        End If
+        json = ""
+    Next r
+
+    'if theres more the one record, include brackets for array
+    'if an array_label is given give the array a key and the array become the value
+    'then if the array is labeled with a key it should have braces unless specified otherwise
+    If r > 2 Or force_array Then
+        ajson = "[" & ajson & "]"
+        If array_label <> "" Then
+            ajson = """" & array_label & """:" & ajson
+            If Not strip_braces Then
+                ajson = "{" & ajson & "}"
+            End If
+        End If
+    Else
+        If strip_braces Then
+            ajson = Mid(ajson, 2, Len(ajson) - 2)
+        End If
+    End If
+
+    json_from_table_zb = ajson
+
+End Function
+
+Public Function SHTp_get_block(point As Range) As Variant()
+
+    SHTp_get_block = point.CurrentRegion
+
+End Function
+
+Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox, ParamArray cols())
+
+    Dim i As Long
+
+    hdr.ColumnCount = det.ColumnCount
+    hdr.ColumnWidths = det.ColumnWidths
+
+    ' add header elements
+    hdr.clear
+    hdr.AddItem
+    For i = 0 To UBound(cols, 1)
+        hdr.list(0, i) = cols(i)
+    Next i
+
+    ' make it pretty
+    'body.ZOrder (1)
+    'lbHEAD.ZOrder (0)
+    hdr.SpecialEffect = fmSpecialEffectFlat
+    'hdr.BackColor = RGB(200, 200, 200)
+    'hdr.Height = 15
+
+    ' align header to body (should be done last!)
+    hdr.width = det.width
+    hdr.Left = det.Left
+    hdr.Top = det.Top - (hdr.Height + 3)
+
+End Sub
+
+Public Function IntersectsWith(Range1 As Range, Range2 As Range) As Boolean
+    IntersectsWith = Not Application.Intersect(Range1, Range2) Is Nothing
+End Function
+
+

Master Template.xlsm_EXPORTS/build.frm

@@ -0,0 +1,39 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build 
+   Caption         =   "Change the Mix"
+   ClientHeight    =   1590
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   10725
+   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
+Option Explicit
+
+Public useval As Boolean
+
+Private Sub cmdCancel_Click()
+    useval = False
+    Me.Hide
+End Sub
+
+Private Sub cmdOK_Click()
+    useval = True
+    Me.Hide
+End Sub
+
+Public Sub Initialize(part As String, billTo As String, shipTo As String)
+    cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.Value
+    cbPart.Value = part
+    cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.Value
+    cbBill.Value = billTo
+    cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.Value
+    cbShip.Value = shipTo
+    
+    useval = False
+End Sub

Master Template.xlsm_EXPORTS/changes.frm

@@ -0,0 +1,75 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes 
+   Caption         =   "History"
+   ClientHeight    =   7815
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   16710
+   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 UserForm_Activate()
+    tbPrint.Value = ""
+    
+    Dim fail As Boolean
+    X = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & shData.Cells(2, 5) & """}}", fail)
+    If fail Then
+        Unload Me
+        MsgBox ("No adjustments have been made.")
+        End
+    End If
+    Me.lbHist.list = X
+    Call Utils.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id")
+End Sub
+
+Private Sub cbCancel_Click()
+    Me.Hide
+End Sub
+
+Private Sub cbUndo_Click()
+    Call Me.delete_selected
+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, 7)
+            Exit Sub
+        End If
+    Next i
+End Sub
+
+Sub delete_selected()
+    Dim logid As Integer
+    Dim i As Integer
+    Dim fail As Boolean
+    Dim proceed As Boolean
+    
+    If MsgBox("Permanently delete these changes?", vbYesNo) = vbNo Then
+        Exit Sub
+    End If
+    
+    For i = 0 To Me.lbHist.ListCount - 1
+        If Me.lbHist.Selected(i) Then
+            Call handler.undo_changes(X(i, 6), fail)
+            If fail Then
+                MsgBox ("Undo did not work.")
+                Exit Sub
+            End If
+        End If
+    Next i
+    
+    shOrders.PivotTables("ptOrders").PivotCache.Refresh
+    
+    Me.lbHist.clear
+    Me.Hide
+End Sub

Master Template.xlsm_EXPORTS/fpvt.frm

@@ -0,0 +1,559 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt 
+   Caption         =   "Forecast Adjustment"
+   ClientHeight    =   8490.001
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   8670.001
+   OleObjectBlob   =   "fpvt.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "fpvt"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private month() As Variant
+Private adjust As Object
+Private load_tb As Boolean
+Private set_Price As Boolean
+Private sp As Object
+
+Private bVol As Double
+Private bVal As Double
+Private bPrc As Double
+Private pVol As Double
+Private pVal As Double
+Private pPrc As Double
+Private aVol As Double
+Private aVal As Double
+Private aPrc As Double
+Private fVol As Double
+Private fVal As Double
+Private fPrc As Double
+
+'=====================================================================================================
+' Developers' backdoor to enter or exit debug mode: Ctrl-RightClick on the "Selected Scenario"
+' label at the top of the form. Debug Mode shows the Pending Changes tab in the form, as well
+' as all hidden sheets.
+Private Sub Label62_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+    If Button = 2 And Shift = 2 Then
+        shConfig.Range("debug_mode") = Not shConfig.Range("debug_mode")
+        mp.Pages("pAPIDOC").Visible = shConfig.Range("debug_mode")
+    End If
+End Sub
+'=====================================================================================================
+
+Private Sub butAdjust_Click()
+    Dim fail As Boolean
+    Dim msg As String
+    
+    If tbAPI.text = "" Then msg = "No adjustments provided."
+    If cbTAG.text = "" Then msg = "No tag was selected."
+    If tbAPI.text = "" Then msg = "No adjustements are ready."
+    
+    If msg <> "" Then
+        MsgBox msg, vbOKOnly Or vbExclamation
+        Exit Sub
+    End If
+
+    If Not handler.request_adjust(tbAPI.text, msg) Then
+        MsgBox msg, vbOKOnly Or vbExclamation, "Adjustment was not made due to error."
+        Exit Sub
+    End If
+
+    Me.tbCOM = ""
+    Me.cbTAG.text = ""
+    
+    Me.Hide
+
+    Set adjust = Nothing
+End Sub
+
+Private Sub butCancel_Click()
+    Me.Hide
+End Sub
+
+Private Sub cbGoSheet_Click()
+    shMonthView.Range("MonthComment").Value = ""
+    shMonthView.Range("MonthTag").Value = ""
+    shMonthView.Range("QtyPctChange").Value = 0
+    shMonthView.Range("PricePctChange").Value = 0
+    shMonthView.Visible = xlSheetVisible
+    shMonthView.Select
+    Me.Hide
+End Sub
+
+Private Sub cbTAG_Change()
+    Dim j As Object
+    If tbAPI.text = "" Then tbAPI.text = "{}"
+    Set j = JsonConverter.ParseJson(tbAPI.text)
+    j("tag") = cbTAG.Value
+    tbAPI.text = JsonConverter.ConvertToJson(j)
+End Sub
+
+Private Sub opEditPrice_Click()
+    opPlugVol.Visible = False
+    opPlugPrice.Visible = False
+'    opPlugPrice.Value = True
+'    opPlugVol.Value = False
+
+    tbFcPrice.Enabled = True
+    tbFcPrice.BackColor = &H80000018
+    tbFcVal.Enabled = False
+    tbFcVal.BackColor = &H80000005
+    tbFcVol.Enabled = True
+    tbFcVol.BackColor = &H80000018
+
+    sbpv.Enabled = True
+    sbpp.Enabled = True
+    sbpd.Enabled = False
+    tbpv.Enabled = True
+    tbpp.Enabled = True
+    tbpd.Enabled = False
+End Sub
+
+Private Sub opEditSales_Click()
+    opPlugVol.Visible = True
+    opPlugPrice.Visible = True
+
+    tbFcPrice.Enabled = False
+    tbFcPrice.BackColor = &H80000005
+    tbFcVal.Enabled = True
+    tbFcVal.BackColor = &H80000018
+    tbFcVol.Enabled = False
+    tbFcVol.BackColor = &H80000005
+
+    sbpv.Enabled = False
+    sbpp.Enabled = False
+    sbpd.Enabled = True
+    tbpv.Enabled = False
+    tbpp.Enabled = False
+    tbpd.Enabled = True
+End Sub
+
+Private Sub opPlugPrice_Click()
+    calc_val
+End Sub
+
+Private Sub opPlugVol_Click()
+    calc_val
+End Sub
+
+Private Sub sbpd_Change()
+    tbpd.Value = sbpd.Value
+End Sub
+
+Private Sub sbpp_Change()
+    tbpp.Value = sbpp.Value
+End Sub
+
+Private Sub sbpv_Change()
+    tbpv.Value = sbpv.Value
+End Sub
+
+Private Sub tbCOM_Change()
+    If tbAPI.text = "" Then tbAPI.text = "{}"
+    Set adjust = JsonConverter.ParseJson(tbAPI.text)
+    adjust("message") = tbCOM.text
+    tbAPI.text = JsonConverter.ConvertToJson(adjust)
+End Sub
+
+Private Sub tbFcPrice_Change()
+    If load_tb Then Exit Sub
+    set_Price = True
+    If opEditPrice Then calc_price
+    set_Price = False
+End Sub
+
+Private Sub tbFcVal_Change()
+    If load_tb Then Exit Sub
+    If opEditSales Then calc_val
+End Sub
+
+Private Sub tbFcVol_Change()
+    If load_tb Then Exit Sub
+    If opEditPrice Then calc_price
+End Sub
+
+Private Sub tbpd_Change()
+    If load_tb Then Exit Sub
+    If Not VBA.IsNumeric(tbpd.Value) Then Exit Sub
+    tbFcVal = (bVal + pVal) * (1 + tbpd.Value / 100)
+End Sub
+
+Private Sub tbpp_Change()
+    If load_tb Then Exit Sub
+    If Not VBA.IsNumeric(tbpd.Value) Then Exit Sub
+    tbFcPrice = (bPrc + pPrc) * (1 + tbpp.Value / 100)
+    Me.load_mbox_ann
+End Sub
+
+Private Sub tbpv_Change()
+    If load_tb Then Exit Sub
+    If Not VBA.IsNumeric(tbpv.Value) Then Exit Sub
+    tbFcVol = (bVol + pVol) * (1 + tbpv.Value / 100)
+End Sub
+
+Private Sub UserForm_Activate()
+    Me.Caption = "Forecast Adjust " & shConfig.Range("version").Value & "   Loading..."
+    Me.mp.Visible = False
+    Me.fraExit.Visible = False
+
+    Dim ok As Boolean
+    Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
+    Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
+
+    Me.Caption = "Forecast Adjust " & shConfig.Range("version").Value
+
+    If Not ok Then
+        fpvt.Hide
+        Application.StatusBar = False
+        Exit Sub
+    End If
+
+    '---show existing adjustment if there is one----
+    pVol = 0
+    pVal = 0
+    pPrc = 0
+    bVol = 0
+    bVal = 0
+    bPrc = 0
+    aVol = 0
+    aVal = 0
+    aPrc = 0
+    fVal = 0
+    fVol = 0
+    fPrc = 0
+    Me.tbAPI.Value = ""
+
+    If IsNull(sp("package")("totals")) Then
+        MsgBox "An unexpected error has occurred when retrieving the scenario.", vbOKOnly Or vbExclamation, "Error"
+        fpvt.Hide
+        Application.StatusBar = False
+        Exit Sub
+    End If
+
+    Dim i As Long
+    For i = 1 To sp("package")("totals").Count
+        Select Case sp("package")("totals")(i)("order_season")
+            Case 2025
+                Select Case Me.iter_def(sp("package")("totals")(i)("iter"))
+                    Case "baseline"
+                        bVol = bVol + sp("package")("totals")(i)("units")
+                        bVal = bVal + sp("package")("totals")(i)("value_usd")
+                        If bVol <> 0 Then bPrc = bVal / bVol
+
+                    Case "adjust"
+                        pVol = pVol + sp("package")("totals")(i)("units")
+                        pVal = pVal + sp("package")("totals")(i)("value_usd")
+
+                    Case "exclude"
+
+                End Select
+        End Select
+    Next i
+
+    fVol = bVol + pVol
+    fVal = bVal + pVal
+    If fVol = 0 Then
+        fPrc = 0
+    Else
+        fPrc = fVal / fVol
+    End If
+    If (bVol + pVol) = 0 Then
+        pPrc = 0
+    Else
+        If bVol = 0 Then
+            pPrc = 0
+        Else
+            pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
+        End If
+    End If
+    If aVal <> 0 Then
+        MsgBox (aVal)
+    End If
+    Me.load_mbox_ann
+
+    '---------------------------------------populate monthly-------------------------------------------------------
+
+    '--parse json into variant array for loading--
+    ReDim month(sp("package")("mpvt").Count + 1, 10)
+
+    For i = 1 To sp("package")("mpvt").Count
+        month(i, 0) = sp("package")("mpvt")(i)("order_month")
+        month(i, 1) = sp("package")("mpvt")(i)("2024 qty")
+        month(i, 2) = sp("package")("mpvt")(i)("2025 base qty")
+        month(i, 3) = sp("package")("mpvt")(i)("2025 adj qty")
+        month(i, 4) = sp("package")("mpvt")(i)("2025 tot qty")
+        month(i, 5) = sp("package")("mpvt")(i)("2024 value_usd")
+        month(i, 6) = sp("package")("mpvt")(i)("2025 base value_usd")
+        month(i, 7) = sp("package")("mpvt")(i)("2025 adj value_usd")
+        month(i, 8) = sp("package")("mpvt")(i)("2025 tot value_usd")
+        If co_num(month(i, 2), 0) = 0 Then
+            month(i, 9) = "addmonth"
+        Else
+            month(i, 9) = "scale"
+        End If
+    Next i
+    
+    Me.crunch_array
+
+    ReDim basket(sp("package")("basket").Count, 3)
+    basket(0, 0) = "part_descr"
+    basket(0, 1) = "bill_cust_descr"
+    basket(0, 2) = "ship_cust_descr"
+    basket(0, 3) = "mix"
+
+    For i = 1 To UBound(basket, 1)
+        basket(i, 0) = sp("package")("basket")(i)("part_descr")
+        basket(i, 1) = sp("package")("basket")(i)("bill_cust_descr")
+        basket(i, 2) = sp("package")("basket")(i)("ship_cust_descr")
+        basket(i, 3) = sp("package")("basket")(i)("mix")
+    Next i
+
+    '-------------load tags-------------------------------
+    cbTAG.list = shConfig.ListObjects("TAGS").DataBodyRange.Value
+
+    '----------reset spinner buttons----------------------
+    sbpv.Value = 0
+    sbpp.Value = 0
+    sbpd.Value = 0
+
+    Call handler.month_tosheet(month, basket)
+    Application.StatusBar = False
+
+    Me.mp.Visible = True
+    Me.fraExit.Visible = True
+End Sub
+
+Sub crunch_array()
+
+    Dim i As Integer
+
+    month(13, 1) = 0
+    month(13, 2) = 0
+    month(13, 3) = 0
+    month(13, 4) = 0
+    month(13, 5) = 0
+    month(13, 6) = 0
+    month(13, 7) = 0
+    month(13, 8) = 0
+
+    For i = 1 To 12
+        month(13, 1) = month(13, 1) + co_num(month(i, 1), 0)
+        month(13, 2) = month(13, 2) + co_num(month(i, 2), 0)
+        month(13, 3) = month(13, 3) + co_num(month(i, 3), 0)
+        month(13, 4) = month(13, 4) + co_num(month(i, 4), 0)
+        month(13, 5) = month(13, 5) + co_num(month(i, 5), 0)
+        month(13, 6) = month(13, 6) + co_num(month(i, 6), 0)
+        month(13, 7) = month(13, 7) + co_num(month(i, 7), 0)
+        month(13, 8) = month(13, 8) + co_num(month(i, 8), 0)
+    Next i
+
+    ReDim mload(UBound(month, 1), 5)
+    For i = 0 To UBound(month, 1)
+        mload(i, 0) = month(i, 0)
+        mload(i, 1) = Format(month(i, 1), "#,###")
+        mload(i, 2) = Format(month(i, 4), "#,###")
+        mload(i, 3) = Format(month(i, 5), "#,###")
+        mload(i, 4) = Format(month(i, 8), "#,###")
+    Next i
+End Sub
+
+Public Function rev_cust(cust As String) As String
+    If cust = "" Then
+        rev_cust = ""
+        Exit Function
+    End If
+
+    If InStr(1, cust, " - ") <= 9 Then
+        rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(Left(cust, 8))
+    Else
+        rev_cust = trim(Right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - "))
+    End If
+
+End Function
+
+Sub load_mbox_ann()
+
+    load_tb = True
+
+    tbBaseVol = Format(bVol, "#,##0")
+    tbBaseVal = Format(bVal, "#,##0")
+    tbBasePrice = Format(bPrc, "0.00000")
+
+    tbPadjVol = Format(pVol, "#,##0")
+    tbPadjVal = Format(pVal, "#,##0")
+    tbPadjPrice = Format(pPrc, "0.00000")
+
+    tbFcVol = Format(fVol, "#,##0")
+    tbFcVal = Format(fVal, "#,##0")
+    If Not set_Price Then tbFcPrice = Format(fPrc, "0.00000")
+
+    tbAdjVol = Format(aVol, "#,##0")
+    tbAdjVal = Format(aVal, "#,##0")
+    tbAdjPrice = Format(aPrc, "0.00000")
+
+    load_tb = False
+End Sub
+
+Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
+
+    If Not IsNumeric(one) Or IsNull(one) Then
+        co_num = two
+    Else
+        co_num = one
+    End If
+
+End Function
+
+Sub calc_val()
+
+    Dim pchange As Double
+
+    If IsNumeric(tbFcVal.Value) Then
+        'get textbox value
+        fVal = tbFcVal.Value
+        'do calculations
+        aVal = fVal - bVal - pVal
+
+        '---------if volume adjustment method is selected, scale the volume up----------------------------------
+        If opPlugVol Then
+            If (Round(pVal, 2) + Round(bVal, 2)) = 0 Then
+                pchange = 0
+                If co_num(pVal, bVal) = 0 Then
+                    MsgBox "Zero times any number is zero. Cannot scale to get to the target."
+                Else
+                    fVol = fVal / (co_num(bVal, pVal) / co_num(bVol, pVol))
+                End If
+            Else
+                pchange = fVal / (pVal + bVal)
+                fVol = (pVol + bVol) * pchange
+            End If
+
+        Else
+            fVol = pVol + bVol
+        End If
+        If fVol = 0 Then
+            fPrc = 0
+        Else
+            fPrc = fVal / fVol
+        End If
+        aVol = fVol - (bVol + pVol)
+        aPrc = fPrc - (bPrc + pPrc)
+    Else
+        aVol = fVol - bVol - pVol
+        aPrc = 0
+
+    End If
+    tbFcVal = Format(co_num(tbFcVal, 0), "#,##0")
+
+    Me.load_mbox_ann
+
+    'build json
+    Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
+    adjust("scenario")("version") = handler.plan
+    adjust("scenario")("iter") = handler.basis
+    adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
+    adjust("user") = Application.UserName
+    adjust("source") = "adj"
+    adjust("message") = tbCOM.text
+    adjust("tag") = cbTAG.text
+    If opEditSales Then
+        If opPlugVol Then
+            adjust("type") = "scale_v"
+            adjust("amount") = aVal
+            adjust("qty") = aVol
+        Else
+            adjust("type") = "scale_p"
+            adjust("amount") = aVal
+        End If
+    Else
+        adjust("type") = "scale_vp"
+        adjust("qty") = aVol
+        adjust("amount") = aVal
+    End If
+
+    'print json
+    tbAPI = JsonConverter.ConvertToJson(adjust)
+End Sub
+
+Sub calc_price()
+    fVol = co_num(tbFcVol.Value, 0)
+    fPrc = co_num(tbFcPrice.Value, 0)
+    'calc
+    fVal = fPrc * fVol
+    aVal = fVal - bVal - pVal
+    aVol = fVol - (bVol + pVol)
+
+    If (bVol + pVol) = 0 Then
+        aPrc = 0
+    Else
+        'aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol))
+        aPrc = fPrc - (bPrc + pPrc)
+    End If
+    'End If
+
+    Me.load_mbox_ann
+
+    'build json
+    Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
+    adjust("scenario")("version") = handler.plan
+    adjust("scenario")("iter") = handler.basis
+    adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
+    adjust("user") = Application.UserName
+    adjust("source") = "adj"
+    adjust("message") = tbCOM.text
+    adjust("tag") = cbTAG.text
+    adjust("version") = handler.plan
+
+    If opEditSales Then
+        If opPlugVol Then
+            adjust("type") = "scale_v"
+            adjust("amount") = aVal
+        Else
+            adjust("type") = "scale_p"
+            adjust("amount") = aVal
+        End If
+    Else
+        If aVol = 0 Then
+            adjust("type") = "scale_p"
+        Else
+            adjust("type") = "scale_vp"
+        End If
+        adjust("qty") = aVol
+        adjust("amount") = aVal
+    End If
+
+    'print json
+    tbAPI = JsonConverter.ConvertToJson(adjust)
+End Sub
+
+Function iter_def(ByVal iter As String) As String
+
+    Dim i As Integer
+
+    For i = 0 To UBound(handler.baseline)
+        If handler.baseline(i) = iter Then
+            iter_def = "baseline"
+            Exit Function
+        End If
+    Next i
+
+    For i = 0 To UBound(handler.adjust)
+        If handler.adjust(i) = iter Then
+            iter_def = "adjust"
+            Exit Function
+        End If
+    Next i
+
+    iter_def = "exclude"
+
+End Function
+
+
+
+

Master Template.xlsm_EXPORTS/handler.bas

@@ -0,0 +1,655 @@
+Attribute VB_Name = "handler"
+Option Explicit
+
+Public sql As String
+Public jsql As String
+Public scenario As String
+Public sc() As Variant
+Public data() As String
+Public agg() As String
+Public showprice As Boolean
+Public server As String
+Public plan As String
+Public basis() As Variant
+Public baseline() As Variant
+Public adjust() As Variant
+
+
+Sub load_fpvt()
+
+    Application.StatusBar = "retrieving selection data....."
+
+    Dim i As Long
+    Dim s_tot As Object
+
+    fpvt.lbSDET.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
+        Debug.Print "GET /scenario_package (";
+        Dim t As Single
+        t = Timer
+        .WaitForResponse
+        wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
+    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(catg As String, rep As String)
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim wr As String
+    Dim json As Object
+    Dim doc As String
+    Dim res() As Variant
+
+    doc = "{""scenario"":{""" & catg & """:""" & rep & """}}"
+
+    Application.StatusBar = "Querying for " & rep & "'s pool of data..."
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", handler.server & "/get_pool", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        Debug.Print "GET /get_pool (";
+        Dim t As Single
+        t = Timer
+        .WaitForResponse
+        wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
+    End With
+
+    If Mid(wr, 1, 1) <> "{" Then
+        MsgBox (wr)
+        Exit Sub
+    End If
+
+    Application.StatusBar = "Parsing query results..."
+    Set json = JsonConverter.ParseJson(wr)
+
+    If IsNull(json("x")) Then
+        MsgBox "No data found for " & rep & "."
+        Exit Sub
+    End If
+
+    ReDim res(0, 34)
+    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"
+    res(0, 6) = "segm"
+    res(0, 7) = "substance"
+    res(0, 8) = "chan"
+    res(0, 9) = "chansub"
+    res(0, 10) = "part_descr"
+    res(0, 11) = "part_group"
+    res(0, 12) = "branding"
+    res(0, 13) = "majg_descr"
+    res(0, 14) = "ming_descr"
+    res(0, 15) = "majs_descr"
+    res(0, 16) = "mins_descr"
+    res(0, 17) = "order_season"
+    res(0, 18) = "order_month"
+    res(0, 19) = "ship_season"
+    res(0, 20) = "ship_month"
+    res(0, 21) = "request_season"
+    res(0, 22) = "request_month"
+    res(0, 23) = "promo"
+    res(0, 24) = "value_loc"
+    res(0, 25) = "value_usd"
+    res(0, 26) = "cost_loc"
+    res(0, 27) = "cost_usd"
+    res(0, 28) = "units"
+    res(0, 29) = "version"
+    res(0, 30) = "iter"
+    res(0, 31) = "logid"
+    res(0, 32) = "tag"
+    res(0, 33) = "comment"
+    res(0, 34) = "pounds"
+
+    shData.Cells.ClearContents
+    Call Utils.SHTp_DumpVar(res, shData.Name, 1, 1, False, True, True)
+
+    Dim batchSize As Integer
+    batchSize = 1000
+    Dim totalRows As Long
+    totalRows = json("x").Count
+    Dim jsonRow As Long
+    jsonRow = 1
+    Dim sheetRow As Long
+    sheetRow = 2
+    Dim arrayRow As Long
+
+    ' While the JSON array still has rows,
+    '   1. move the 1st one to a VBA 2-D array, deleting it from the JSON array.
+    '   2. When 1000 have been copied, put the values onto the worksheet, and
+    '      empty the VBA array.
+    ' Splitting the JSON array into smaller batches when creating the VBA array
+    ' means there is less memory needed for the operation.
+    Do While json("x").Count > 0
+        If jsonRow Mod batchSize = 1 Then
+            ReDim res(batchSize - 1, 34)
+            arrayRow = 0
+        End If
+        res(arrayRow, 0) = json("x")(1)("bill_cust_descr")
+        res(arrayRow, 1) = json("x")(1)("billto_group")
+        res(arrayRow, 2) = json("x")(1)("ship_cust_descr")
+        res(arrayRow, 3) = json("x")(1)("shipto_group")
+        res(arrayRow, 4) = json("x")(1)("quota_rep_descr")
+        res(arrayRow, 5) = json("x")(1)("director")
+        res(arrayRow, 6) = json("x")(1)("segm")
+        res(arrayRow, 7) = json("x")(1)("substance")
+        res(arrayRow, 8) = json("x")(1)("chan")
+        res(arrayRow, 9) = json("x")(1)("chansub")
+        res(arrayRow, 10) = json("x")(1)("part_descr")
+        res(arrayRow, 11) = json("x")(1)("part_group")
+        res(arrayRow, 12) = json("x")(1)("branding")
+        res(arrayRow, 13) = json("x")(1)("majg_descr")
+        res(arrayRow, 14) = json("x")(1)("ming_descr")
+        res(arrayRow, 15) = json("x")(1)("majs_descr")
+        res(arrayRow, 16) = json("x")(1)("mins_descr")
+        res(arrayRow, 17) = json("x")(1)("order_season")
+        res(arrayRow, 18) = json("x")(1)("order_month")
+        res(arrayRow, 19) = json("x")(1)("ship_season")
+        res(arrayRow, 20) = json("x")(1)("ship_month")
+        res(arrayRow, 21) = json("x")(1)("request_season")
+        res(arrayRow, 22) = json("x")(1)("request_month")
+        res(arrayRow, 23) = json("x")(1)("promo")
+        res(arrayRow, 24) = json("x")(1)("value_loc")
+        res(arrayRow, 25) = json("x")(1)("value_usd")
+        res(arrayRow, 26) = json("x")(1)("cost_loc")
+        res(arrayRow, 27) = json("x")(1)("cost_usd")
+        res(arrayRow, 28) = json("x")(1)("units")
+        res(arrayRow, 29) = json("x")(1)("version")
+        res(arrayRow, 30) = json("x")(1)("iter")
+        res(arrayRow, 31) = json("x")(1)("logid")
+        res(arrayRow, 32) = json("x")(1)("tag")
+        res(arrayRow, 33) = json("x")(1)("comment")
+        res(arrayRow, 34) = json("x")(1)("pounds")
+        json("x").Remove 1
+        arrayRow = arrayRow + 1
+        If jsonRow Mod batchSize = 0 Or json("x").Count = 0 Then
+            Application.StatusBar = "Populating spreadsheet: " & Format(jsonRow, "#,##0") & " of " & Format(totalRows, "#,##0") & " rows..."
+            Call Utils.SHTp_DumpVar(res, shData.Name, sheetRow, 1, False, True, True)
+            sheetRow = sheetRow + batchSize
+        End If
+        jsonRow = jsonRow + 1
+    Loop
+
+    Set json = Nothing
+    Application.StatusBar = False
+End Sub
+
+Sub pull_rep()
+    openf.Show
+End Sub
+
+
+
+Function request_adjust(doc As String, ByRef msg As String) As Boolean
+
+    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
+
+    request_adjust = False
+
+    If doc = "" Then
+        msg = "No data was given to be processed."
+        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 = shConfig.Range("server").Value
+
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "POST", server & "/" & json("type"), True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        Debug.Print "GET /"; json("type"); " (";
+        Dim t As Single
+        t = Timer
+        .WaitForResponse
+        wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
+    End With
+
+    If Mid(wr, 2, 5) = "error" Or _
+        Mid(wr, 1, 6) = "<body>" Or _
+        Mid(wr, 1, 6) = "<!DOCT" _
+    Then
+        msg = wr
+        Exit Function
+    End If
+
+    If Mid(wr, 1, 6) = "null" Then
+        msg = "API route not implemented"
+        Exit Function
+    End If
+
+    Set json = JsonConverter.ParseJson(wr)
+
+    If IsNull(json("x")) Then
+        msg = "No adjustment was made."
+        Exit Function
+    End If
+
+    ReDim res(json("x").Count - 1, 34)
+
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("bill_cust_descr")
+        res(i, 1) = json("x")(i + 1)("billto_group")
+        res(i, 2) = json("x")(i + 1)("ship_cust_descr")
+        res(i, 3) = json("x")(i + 1)("shipto_group")
+        res(i, 4) = json("x")(i + 1)("quota_rep_descr")
+        res(i, 5) = json("x")(i + 1)("director")
+        res(i, 6) = json("x")(i + 1)("segm")
+        res(i, 7) = json("x")(i + 1)("substance")
+        res(i, 8) = json("x")(i + 1)("chan")
+        res(i, 9) = json("x")(i + 1)("chansub")
+        res(i, 10) = json("x")(i + 1)("part_descr")
+        res(i, 11) = json("x")(i + 1)("part_group")
+        res(i, 12) = json("x")(i + 1)("branding")
+        res(i, 13) = json("x")(i + 1)("majg_descr")
+        res(i, 14) = json("x")(i + 1)("ming_descr")
+        res(i, 15) = json("x")(i + 1)("majs_descr")
+        res(i, 16) = json("x")(i + 1)("mins_descr")
+        res(i, 17) = json("x")(i + 1)("order_season")
+        res(i, 18) = json("x")(i + 1)("order_month")
+        res(i, 19) = json("x")(i + 1)("ship_season")
+        res(i, 20) = json("x")(i + 1)("ship_month")
+        res(i, 21) = json("x")(i + 1)("request_season")
+        res(i, 22) = json("x")(i + 1)("request_month")
+        res(i, 23) = json("x")(i + 1)("promo")
+        res(i, 24) = json("x")(i + 1)("value_loc")
+        res(i, 25) = json("x")(i + 1)("value_usd")
+        res(i, 26) = json("x")(i + 1)("cost_loc")
+        res(i, 27) = json("x")(i + 1)("cost_usd")
+        res(i, 28) = json("x")(i + 1)("units")
+        res(i, 29) = json("x")(i + 1)("version")
+        res(i, 30) = json("x")(i + 1)("iter")
+        res(i, 31) = json("x")(i + 1)("logid")
+        res(i, 32) = json("x")(i + 1)("tag")
+        res(i, 33) = json("x")(i + 1)("comment")
+        res(i, 34) = json("x")(i + 1)("pounds")
+    Next i
+
+    request_adjust = True
+    
+    i = shData.UsedRange.Rows.Count + 1
+    Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
+    shOrders.PivotTables("ptOrders").PivotCache.Refresh
+    
+End Function
+
+Sub load_config()
+
+    Dim i As Integer
+    '----server to use---------------------------------------------------------
+    handler.server = shConfig.Range("server").Value
+    '---basis------------------------------------------------------------------
+    With shConfig.ListObjects("BASIS")
+        For i = 1 To .DataBodyRange.Rows.Count
+            ReDim Preserve handler.basis(i - 1)
+            handler.basis(i - 1) = .DataBodyRange(i, 1)
+        Next
+    End With
+    '---baseline-----------------------------------------------------------------
+    With shConfig.ListObjects("BASELINE")
+        For i = 1 To .DataBodyRange.Rows.Count
+            ReDim Preserve handler.baseline(i - 1)
+            handler.baseline(i - 1) = .DataBodyRange(i, 1)
+        Next
+    End With
+    '---adjustments-----------------------------------------------------------------
+    With shConfig.ListObjects("ADJUST")
+        For i = 1 To .DataBodyRange.Rows.Count
+            ReDim Preserve handler.adjust(i - 1)
+            handler.adjust(i - 1) = .DataBodyRange(i, 1)
+        Next
+    End With
+    '---plan version--------------------------------------------------------------
+    handler.plan = shConfig.Range("budget").Value
+
+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
+
+    With shMonthUpdate
+
+        Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
+        .Cells(1, 16) = JsonConverter.ConvertToJson(j)
+
+        For i = 1 To 12
+            '------------volume-------------------
+            .Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
+            .Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
+            .Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
+            .Cells(i + 1, 4) = 0
+            .Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
+
+            '------------value----------------------
+            .Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
+            .Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
+            .Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
+            .Cells(i + 1, 14) = 0
+            .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
+                    .Cells(i + 1, 6) = 0
+                Else
+                    .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 .Cells(i, 7) <> 0 Then
+                        .Cells(i + 1, 7) = .Cells(i, 7)
+                    Else
+                        If pkg(13, 1) + pkg(13, 2) = 0 Then
+                            .Cells(i + 1, 7) = 0
+                        Else
+                            .Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
+                        End If
+                    End If
+                Else
+                    .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
+                    .Cells(i + 1, 8) = 0
+                Else
+                    .Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
+                End If
+
+                '--current adjust--
+                .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 .Cells(i, 10) <> 0 Then
+                        .Cells(i + 1, 10) = .Cells(i, 10)
+                    Else
+                        If pkg(13, 1) + pkg(13, 2) = 0 Then
+                            .Cells(i + 1, 10) = 0
+                        Else
+                            .Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
+                        End If
+                    End If
+                Else
+                    .Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
+                End If
+
+            End If
+
+        Next i
+
+        'scenario
+        .Range("R1:S1000").ClearContents
+        For i = 0 To UBound(handler.sc, 1)
+            .Cells(i + 1, 18) = handler.sc(i, 0)
+            .Cells(i + 1, 19) = handler.sc(i, 1)
+        Next i
+
+        'basket
+        .Range("U1:AC100000").ClearContents
+        Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True)
+        Call Utils.SHTp_DumpVar(basket, .Name, 1, 26, False, False, True)
+        shConfig.Range("rebuild").Value = 0
+        shConfig.Range("show_basket").Value = 0
+        shConfig.Range("new_part").Value = 0
+
+        shMonthView.LoadSheet
+
+    End With
+
+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 Long
+    Dim j As Long
+    Dim res() As Variant
+
+    If doc = "" Then
+        fail = True
+        Exit Function
+    End If
+
+    server = shConfig.Range("server").Value
+
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/list_changes", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        Debug.Print "GET /list_changes (";
+        Dim t As Single
+        t = Timer
+        .WaitForResponse
+        wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+
+    If IsNull(json("x")) Then
+        fail = True
+        Exit Function
+    End If
+
+    ReDim res(json("x").Count - 1, 7)
+
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("user")
+        res(i, 1) = json("x")(i + 1)("quota_rep_descr")
+        res(i, 2) = json("x")(i + 1)("stamp")
+        res(i, 3) = json("x")(i + 1)("tag")
+        res(i, 4) = json("x")(i + 1)("comment")
+        res(i, 5) = json("x")(i + 1)("sales")
+        res(i, 6) = json("x")(i + 1)("id")
+        res(i, 7) = json("x")(i + 1)("doc")
+    Next i
+
+    list_changes = res
+
+End Function
+
+Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant()
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Long
+    Dim j As Long
+    Dim res() As Variant
+    Dim doc As String
+    Dim ds As Worksheet
+
+    doc = "{""logid"":" & logid & "}"
+
+    server = handler.server
+
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/undo_change", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        Debug.Print "GET /undo_change (";
+        Dim t As Single
+        t = Timer
+        .WaitForResponse
+        wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+    logid = json("x")(1)("id")
+
+    '---------loop through and get a list of each row that needs deleted?-----
+
+    j = 0
+    For i = 1 To 100
+        If shData.Cells(1, i) = "logid" Then
+            j = i
+            Exit For
+        End If
+    Next i
+
+    If j = 0 Then
+        MsgBox ("Current data set is not tracking changes. Cannot isolate change locally.")
+        fail = True
+        Exit Function
+    End If
+
+    i = 2
+    With shData
+        While .Cells(i, 1) <> ""
+            If .Cells(i, j) = logid Then
+                .Rows(i).Delete
+            Else
+                i = i + 1
+            End If
+        Wend
+    End With
+
+End Function
+
+
+Sub history()
+
+    changes.Show
+
+End Sub
+
+Function get_swap_fit(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 = shConfig.Range("server").Value
+
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/swap_fit", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        Debug.Print "GET /swap_fit (";
+        Dim t As Single
+        t = Timer
+        .WaitForResponse
+        wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
+    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, 3)
+
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("part")
+        res(i, 1) = json("x")(i + 1)("value_usd")
+        res(i, 2) = json("x")(i + 1)("swap")
+        res(i, 3) = json("x")(i + 1)("fit")
+    Next i
+
+    get_swap_fit = res
+
+End Function
+
+
+

Master Template.xlsm_EXPORTS/openf.frm

@@ -0,0 +1,64 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf 
+   Caption         =   "Open a Forecast"
+   ClientHeight    =   2400
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   8220.001
+   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()
+    If opDSM.Value Then
+        Call handler.pg_main_workset("quota_rep_descr", cbDSM.Value)
+    ElseIf opDirector.Value Then
+        Call handler.pg_main_workset("director", cbDirector.Value)
+    ElseIf opSegment.Value Then
+        Call handler.pg_main_workset("segm", cbSegment.Value)
+    End If
+    shOrders.PivotTables("ptOrders").PivotCache.Refresh
+    openf.Hide
+End Sub
+
+Private Sub cbOK_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+    If Button = 2 And Shift = 2 Then
+        shConfig.Range("debug_mode") = Not shConfig.Range("debug_mode")
+    End If
+End Sub
+
+Private Sub opDSM_Click()
+    cbDSM.Visible = True
+    cbDirector.Visible = False
+    cbSegment.Visible = False
+End Sub
+
+Private Sub opDirector_Click()
+    cbDSM.Visible = False
+    cbDirector.Visible = True
+    cbSegment.Visible = False
+End Sub
+
+Private Sub opSegment_Click()
+    cbDSM.Visible = False
+    cbDirector.Visible = False
+    cbSegment.Visible = True
+End Sub
+
+Private Sub UserForm_Activate()
+    handler.server = shConfig.Range("server").Value
+    cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.Value
+    cbDirector.list = shConfig.ListObjects("DIRECTORS").DataBodyRange.Value
+    cbSegment.list = shConfig.ListObjects("SEGMENTS").DataBodyRange.Value
+End Sub
+
+
+

Master Template.xlsm_EXPORTS/part.frm

@@ -0,0 +1,35 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part 
+   Caption         =   "Part Picker"
+   ClientHeight    =   1335
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   9285.001
+   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
+Option Explicit
+
+Public useval As Boolean
+
+Private Sub cmdCancel_Click()
+    useval = False
+    Me.Hide
+End Sub
+
+Private Sub cmdOK_Click()
+    useval = True
+    Me.Hide
+End Sub
+
+Private Sub UserForm_Activate()
+    useval = False
+    cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.Value
+End Sub
+
+

Master Template.xlsm_EXPORTS/shConfig.cls

@@ -0,0 +1,31 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shConfig"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+Private Sub Worksheet_Change(ByVal Target As Range)
+    If Intersect(Target, shConfig.Range("debug_mode")) Is Nothing Then Exit Sub
+    
+    If shConfig.Range("debug_mode").Value Then
+        shConfig.Visible = xlSheetVisible
+        'shData.Visible = xlSheetVisible
+        shMonthView.Visible = xlSheetVisible
+        shMonthUpdate.Visible = xlSheetVisible
+        shSupportingData.Visible = xlSheetVisible
+        shWalk.Visible = xlSheetVisible
+    Else
+        shConfig.Visible = xlSheetVeryHidden
+        'shData.Visible = xlSheetHidden
+        shMonthView.Visible = xlSheetHidden
+        shMonthUpdate.Visible = xlSheetVeryHidden
+        shSupportingData.Visible = xlSheetVeryHidden
+        shWalk.Visible = xlSheetVeryHidden
+    End If
+End Sub
+

Master Template.xlsm_EXPORTS/shData.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shData"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

Master Template.xlsm_EXPORTS/shHelp.cls

@@ -0,0 +1,11 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shHelp"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+

Master Template.xlsm_EXPORTS/shMonthUpdate.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shMonthUpdate"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

Master Template.xlsm_EXPORTS/shMonthView.cls

@@ -0,0 +1,905 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shMonthView"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+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 busy As Boolean
+Private vedit As String
+Private adjust() As Object
+Private jtext() As Variant
+Private rollback As Boolean
+Private scenario() As Variant
+Private orig As Range
+Private showbasket As Boolean
+Private np As Object 'json dedicated to new part scenario
+Private did_load_config As Boolean
+
+Public Sub MPP_Down()   ' Handler for down-triangle on price percent change.
+    If newpart Then Exit Sub
+
+    With shMonthView.Range("PricePctChange")
+        .Value = WorksheetFunction.Max(-0.1, .Value - 0.01)
+    End With
+    MPP_Change
+End Sub
+
+Public Sub MPP_Up()   ' Handler for up-triangle on price percent change.
+    If newpart Then Exit Sub
+
+    With shMonthView.Range("PricePctChange")
+        .Value = WorksheetFunction.Min(0.1, .Value + 0.01)
+    End With
+    MPP_Change
+End Sub
+
+Private Sub MPP_Change()
+    Dim i As Long
+
+    Application.ScreenUpdating = False
+
+    busy = True
+
+    With shMonthView
+        For i = 1 To 12
+            If .Range("PriceBaseline").Cells(i) > 0 Then
+                .Range("PriceNewAdj").Cells(i) = .Range("PriceBaseline").Cells(i) * .Range("PricePctChange")
+            End If
+        Next i
+    End With
+    Me.mvp_adj
+
+    busy = False
+
+    Application.ScreenUpdating = True
+End Sub
+
+
+Public Sub MPV_Down()   ' Handler for down-triangle on qty percent change.
+    If newpart Then Exit Sub
+
+    With shMonthView.Range("QtyPctChange")
+        .Value = WorksheetFunction.Max(-0.1, .Value - 0.01)
+    End With
+    MPV_Change
+End Sub
+
+Public Sub MPV_Up()   ' Handler for up-triangle on qty percent change.
+    If newpart Then Exit Sub
+
+    With shMonthView.Range("QtyPctChange")
+        .Value = WorksheetFunction.Min(0.1, .Value + 0.01)
+    End With
+    MPV_Change
+End Sub
+
+Private Sub MPV_Change()
+    Dim i As Long
+
+    Application.ScreenUpdating = False
+
+    busy = True
+
+    With shMonthView
+        For i = 1 To 12
+            If .Range("QtyBaseline").Cells(i) <> 0 Then
+                .Range("QtyNewAdj").Cells(i) = .Range("QtyBaseline").Cells(i) * .Range("QtyPctChange")
+            End If
+        Next i
+    End With
+
+    busy = False
+
+    Call Me.mvp_adj
+
+    Application.ScreenUpdating = True
+End Sub
+
+Public Sub ToggleVolumePrice()
+    shMonthView.Range("MonthAdjustVolume").Value = (shMonthView.Range("MonthAdjustVolume").Value <> True)
+    shMonthView.Range("MonthAdjustPrice").Value = Not shMonthView.Range("MonthAdjustVolume").Value
+End Sub
+
+Private Sub Worksheet_Change(ByVal Target As Range)
+    '---this needs checked prior to busy check because % increase spinners are flagged as dumps
+    If Not did_load_config Then
+        Call handler.load_config
+        did_load_config = True
+    End If
+
+    If busy Then Exit Sub
+
+    If (IntersectsWith(Target, Range("units")) Or _
+        IntersectsWith(Target, Range("price")) Or _
+        IntersectsWith(Target, Range("sales"))) And _
+       Target.Columns.Count > 1 _
+    Then
+        MsgBox "You can only change one column at a time. Your change will be undone."
+        busy = True
+        Application.Undo
+        busy = False
+        Exit Sub
+    End If
+
+    If IntersectsWith(Target, Range("QtyNewAdj")) Then Call Me.mvp_adj
+    If IntersectsWith(Target, Range("QtyFinal")) Then Call Me.mvp_set
+    If IntersectsWith(Target, Range("PriceNewAdj")) Then Call Me.mvp_adj
+    If IntersectsWith(Target, Range("PriceFinal")) Then Call Me.mvp_set
+    If IntersectsWith(Target, Range("SalesNewAdj")) Then Call Me.ms_adj
+    If IntersectsWith(Target, Range("SalesFinal")) Then Call Me.ms_set
+
+    If IntersectsWith(Target, Range("basket")) And shConfig.Range("show_basket").Value = 1 Then
+        If RemoveEmptyBasketLines Then ' Lines were removed
+            GetEditBasket shMonthView.Range("basket").Resize(1, 1)  ' Don't "touch" the mix column, so as to rescale all rows proportionally to 100% total.
+        Else
+            GetEditBasket Target
+        End If
+    End If
+End Sub
+
+Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
+    If IntersectsWith(Target, Union(Range("basket_new_item"), Range("basket"))) And shConfig.Range("show_basket").Value = 1 Then
+        Cancel = True
+        Call Me.basket_pick(Target)
+        Target.Select
+    End If
+End Sub
+
+
+Sub picker_shortcut()
+    If IntersectsWith(Selection, Range("basket")) And shConfig.Range("show_basket").Value = 1 Then
+        Call Me.basket_pick(Selection)
+    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
+    GetSheet
+
+    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
+
+    CrunchArray
+    BuildJson
+    SetSheet
+
+
+End Sub
+
+Sub mvp_adj()
+
+    Dim i As Integer
+    GetSheet
+
+    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
+
+    CrunchArray
+    BuildJson
+    SetSheet
+
+
+End Sub
+
+Sub ms_set()
+
+On Error GoTo errh
+
+    Dim i As Integer
+    GetSheet
+
+    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))
+
+            If shMonthView.Range("MonthAdjustVolume") Then
+                If co_num(price(i, 5), 0) = 0 Then
+                    MsgBox "Volume cannot be automatically adjusted because price is 0. Your change will be undone.", vbOKOnly Or vbExclamation, "Division by zero"
+                    busy = True
+                    Application.Undo
+                    busy = False
+                    Exit Sub
+                End If
+                units(i, 5) = sales(i, 5) / price(i, 5)
+                units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
+
+            ElseIf shMonthView.Range("MonthAdjustPrice") Then
+                If co_num(units(i, 5), 0) = 0 Then
+                    MsgBox "Price cannot be automatically adjusted because volume is 0. Your change will be undone.", vbOKOnly Or vbExclamation, "Division by zero"
+                    busy = True
+                    Application.Undo
+                    busy = 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))
+
+            Else
+                MsgBox "Neither Volume or Price was selected. Your change will be undone", vbOKOnly Or vbExclamation, "Bad Setup"
+                busy = True
+                Application.Undo
+                busy = False
+                Exit Sub
+            End If
+        End If
+    Next i
+
+    CrunchArray
+    BuildJson
+    SetSheet
+
+errh:
+    If Err.Number <> 0 Then rollback = True
+
+
+End Sub
+
+Sub ms_adj()
+
+    Dim i As Integer
+    GetSheet
+
+    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)
+
+            If shMonthView.Range("MonthAdjustVolume") Then
+                If co_num(price(i, 5), 0) = 0 Then
+                    MsgBox "Volume cannot be automatically adjusted because price is 0. Your change will be undone.", vbOKOnly Or vbExclamation, "Division by zero"
+                    busy = True
+                    Application.Undo
+                    busy = False
+                    Exit Sub
+                End If
+                units(i, 5) = sales(i, 5) / price(i, 5)
+                units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
+
+            ElseIf shMonthView.Range("MonthAdjustPrice") Then
+                If co_num(units(i, 5), 0) = 0 Then
+                    MsgBox "Price cannot be automatically adjusted because volume is 0. Your change will be undone.", vbOKOnly Or vbExclamation, "Division by zero"
+                    busy = True
+                    Application.Undo
+                    busy = 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))
+
+            Else
+                MsgBox "Neither Volume or Price was selected. Your change will be undone", vbOKOnly Or vbExclamation, "Bad Setup"
+                busy = True
+                Application.Undo
+                busy = False
+                Exit Sub
+            End If
+        End If
+    Next i
+
+    CrunchArray
+    BuildJson
+    SetSheet
+
+End Sub
+
+
+Private Sub GetSheet()
+    With shMonthView
+        units = .Range("units")
+        price = .Range("price")
+        sales = .Range("sales")
+        tunits = .Range("tunits")
+        tprice = .Range("tprice")
+        tsales = .Range("tsales")
+        ReDim adjust(12)
+    End With
+End Sub
+
+Private Function basejson() As Object
+    Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
+End Function
+
+Private Sub SetSheet()
+
+    Dim i As Integer
+
+    busy = True
+
+    With shMonthView
+        .Range("units") = units
+        .Range("price") = price
+        .Range("sales") = sales
+        .Range("tunits").FormulaR1C1 = tunits
+        .Range("tprice").FormulaR1C1 = tprice
+        .Range("tsales").FormulaR1C1 = tsales
+        .Range("scenario").ClearContents
+
+        Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("R1")), .Name, .Range("scenario").row, .Range("scenario").Column, False, False, False)
+        '.Range("B32:Q5000").ClearContents
+    End With
+
+    If Me.newpart Then
+        shMonthUpdate.Range("P2:P13").ClearContents
+        shMonthUpdate.Cells(2, 16) = JsonConverter.ConvertToJson(np)
+    Else
+        For i = 1 To 12
+            shMonthUpdate.Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
+        Next i
+    End If
+
+    busy = False
+
+End Sub
+
+Public Sub LoadSheet()
+
+    units = shMonthUpdate.Range("A2:E13").FormulaR1C1
+    price = shMonthUpdate.Range("F2:J13").FormulaR1C1
+    sales = shMonthUpdate.Range("K2:O13").FormulaR1C1
+    scenario = shMonthUpdate.Range("R1:S13").FormulaR1C1
+    tunits = shMonthView.Range("tunits")
+    tprice = shMonthView.Range("tprice")
+    tsales = shMonthView.Range("tsales")
+    'reset basket
+    shMonthUpdate.Range("U1:X10000").ClearContents
+    Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("Z1")), shMonthUpdate.Name, 1, 21, False, False, False)
+    ReDim adjust(12)
+    CrunchArray
+    SetSheet
+    Call Me.print_basket
+    did_load_config = False
+
+End Sub
+
+Private Sub BuildJson()
+
+    Dim i As Long
+    Dim j As Long
+    Dim pos As Long
+    Dim o As Object
+    Dim m As Object
+    Dim list As Object
+
+    load_config
+
+    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") = handler.plan
+        Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy"",""plan""]")
+        np("source") = "adj"
+        np("type") = "new_basket"
+        np("tag") = shMonthView.Range("MonthTag").Value
+        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(shMonthView.Range("OrderMonths").Cells(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
+                    adjust(pos)("type") = "addmonth_vp"
+                    adjust(pos)("month") = shMonthView.Range("OrderMonths").Cells(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") = shMonthView.Range("OrderMonths").Cells(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") = handler.plan
+                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") = shMonthView.Range("basket").Cells(1, 1).Value
+        'get the basket from the sheet
+        Dim basket() As Variant
+        basket = shMonthUpdate.Range("U1").CurrentRegion.Value
+        Set m = JsonConverter.ParseJson(Utils.json_from_table(basket, "basket", False))
+        If UBound(basket, 1) <= 2 Then
+            Set np("basket") = JsonConverter.ParseJson("[" & Utils.json_from_table(basket, "basket", False) & "]")
+        Else
+            Set np("basket") = m("basket")
+        End If
+    End If
+
+    If Me.newpart Then
+        shMonthUpdate.Range("P2:P13").ClearContents
+        shMonthUpdate.Cells(2, 16) = JsonConverter.ConvertToJson(np)
+    Else
+        For i = 1 To 12
+            shMonthUpdate.Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
+        Next i
+    End If
+
+End Sub
+
+Private Sub CrunchArray()
+
+    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()
+
+    shOrders.Select
+
+End Sub
+
+Sub reset()
+
+    LoadSheet
+
+End Sub
+
+Sub switch_basket()
+    shConfig.Range("show_basket").Value = 1 - shConfig.Range("show_basket").Value
+    Call Me.print_basket
+End Sub
+
+Sub print_basket()
+
+    If shConfig.Range("show_basket").Value = 0 Then
+        busy = True
+        shMonthView.Range("basket").ClearContents
+        busy = False
+        Exit Sub
+    End If
+
+    Dim i As Long
+    Dim basket() As Variant
+    basket = Utils.SHTp_get_block(shMonthUpdate.Range("U1"))
+
+    busy = True
+
+    shMonthView.Range("basket").ClearContents
+    For i = 2 To UBound(basket, 1)
+        shMonthView.Range("basket").Resize(1, 1).Offset(i - 2, 0).Value = basket(i, 1)
+        shMonthView.Range("basket").Resize(1, 1).Offset(i - 2, 4).Value = basket(i, 2)
+        shMonthView.Range("basket").Resize(1, 1).Offset(i - 2, 10).Value = basket(i, 3)
+        shMonthView.Range("basket").Resize(1, 1).Offset(i - 2, 15).Value = basket(i, 4)
+    Next i
+
+    busy = False
+
+End Sub
+
+
+Sub basket_pick(ByRef Target As Range)
+    Dim i As Long
+    With shMonthView
+        build.Initialize .Cells(Target.row, 2), rev_cust(.Cells(Target.row, 6)), rev_cust(.Cells(Target.row, 12))
+        build.Show
+
+        If build.useval Then
+            busy = True
+
+            .Cells(Target.row + i, 2) = build.cbPart.Value
+            .Cells(Target.row + i, 6) = rev_cust(build.cbBill.Value)
+            .Cells(Target.row + i, 12) = rev_cust(build.cbShip.Value)
+            busy = False
+            GetEditBasket Selection
+
+        End If
+    End With
+    Target.Select
+End Sub
+
+Private Function RemoveEmptyBasketLines() As Boolean
+    If busy Then Exit Function
+    busy = True
+
+    RemoveEmptyBasketLines = False
+    Application.ScreenUpdating = False
+
+    Dim lastRow As Long
+    lastRow = shMonthView.UsedRange.row + shMonthView.UsedRange.Rows.Count - 1
+
+    Dim i As Long
+    For i = lastRow To shMonthView.Range("basket").row Step -1
+        If WorksheetFunction.CountA(shMonthView.Cells(i, 1).EntireRow) = 0 Then
+            shMonthView.Cells(i, 1).EntireRow.Delete
+            RemoveEmptyBasketLines = True
+        End If
+    Next
+
+    Application.ScreenUpdating = True
+
+    busy = False
+End Function
+
+Private Sub GetEditBasket(touchedCells As Range)
+    Dim i As Long
+    Dim mix As Double
+    Dim touch_mix As Double
+    Dim untouched As Long
+    Dim touch() As Boolean
+    Dim basket() As Variant
+
+    ReDim basket(0, 3)
+
+    i = WorksheetFunction.CountA(Range("basket").Resize(, 1))
+    If i > 0 Then
+
+        ReDim basket(i - 1, 3)
+        ReDim touch(i - 1)
+        untouched = i
+
+        busy = True
+
+        With shMonthView.Range("basket")
+            mix = 0
+            For i = 1 To .Rows.Count
+                basket(i - 1, 0) = .Cells(i, 1)
+                basket(i - 1, 1) = .Cells(i, 5)
+                basket(i - 1, 2) = .Cells(i, 11)
+                basket(i - 1, 3) = .Cells(i, 16) * 1
+                mix = mix + basket(i - 1, 3)
+                If IntersectsWith(touchedCells, .Cells(i, 16)) Then
+                    touch_mix = touch_mix + basket(i - 1, 3)
+                    touch(i - 1) = True
+                    untouched = untouched - 1
+                End If
+            Next
+
+            'evaluate mix changes, force to 100, and update the sheet
+            For i = 0 To UBound(basket, 1)
+                If Not touch(i) Then
+                    If mix = touch_mix Then
+                        basket(i, 3) = (1 - mix) / untouched
+                    Else
+                        basket(i, 3) = basket(i, 3) + basket(i, 3) * (1 - mix) / (mix - touch_mix)
+                    End If
+                    .Cells(i + 1, 16) = basket(i, 3)
+                End If
+            Next i
+
+        End With
+
+        busy = False
+
+        shMonthUpdate.Range("U2:X5000").ClearContents
+        Call Utils.SHTp_DumpVar(basket, shMonthUpdate.Name, 2, 21, False, False, True)
+
+        If Me.newpart Then
+            BuildJson
+        End If
+    End If
+
+End Sub
+
+
+Sub post_adjust()
+    Dim i As Long
+    Dim msg As String
+
+    If Me.newpart Then
+        If WorksheetFunction.CountA(shMonthView.Range("basket").Resize(, 1)) = 0 Then
+            msg = "At least one row needs to be entered in the lower table. Use the New Business button or double-click in the blue row of the empty table."
+        End If
+
+        If Abs(WorksheetFunction.Sum(shMonthView.Range("basket").Resize(, 1).Offset(0, 15)) - 1#) > 0.000001 Then
+            msg = "The mix column in the lower table does not add up to 100%. Change (or even just retype) one, and the rest will adjust"
+        End If
+
+        If WorksheetFunction.CountIf(shMonthView.Range("SalesFinal"), 0) = 12 And WorksheetFunction.CountIf(shMonthView.Range("SalesNewAdj"), 0) = 12 Then
+            msg = "At least one month needs to have forecast data entered."
+        End If
+    Else
+        If WorksheetFunction.CountA(shMonthUpdate.Range("P2:P13")) = 0 Then msg = "Make sure at least one month has Final values for Volume, Price, and Sales."
+    End If
+
+    If IsEmpty(shMonthView.Range("MonthTag").Value) Then msg = "You need to specify a tag for this update."
+
+    If msg <> "" Then
+        MsgBox msg, vbOKOnly Or vbExclamation
+        Exit Sub
+    End If
+
+    Dim adjust As Object
+    Dim jdoc As String
+
+    If Me.newpart Then
+        Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(2, 16))
+        adjust("message") = shMonthView.Range("MonthComment").Value
+        adjust("tag") = shMonthView.Range("MonthTag").Value
+        jdoc = JsonConverter.ConvertToJson(adjust)
+        If Not handler.request_adjust(jdoc, msg) Then
+            MsgBox msg, vbOKOnly Or vbCritical, "Adjustment was not made."
+            Exit Sub
+        End If
+    Else
+        Dim allMsg As String
+        For i = 2 To 13
+            If shMonthUpdate.Cells(i, 16) <> "" Then
+                Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(i, 16))
+                adjust("message") = shMonthView.Range("MonthComment").Value
+                adjust("tag") = shMonthView.Range("MonthTag").Value
+                jdoc = JsonConverter.ConvertToJson(adjust)
+                If Not handler.request_adjust(jdoc, msg) Then
+                    Dim period As String
+                    period = Format(i - 1, "00") & " - " & Format(DateSerial(2000, (i - 1) + 5, 1), "mmm")
+                    allMsg = IIf(allMsg = "", "", vbNewLine) & period & ": " & msg
+                End If
+            End If
+        Next i
+        
+        If allMsg <> "" Then MsgBox allMsg, vbOKOnly Or vbCritical, "Problems Loading Adjustments"
+    End If
+
+    shOrders.Select
+
+End Sub
+
+Sub build_new()
+
+    shConfig.Range("rebuild").Value = 1
+    Dim i As Long
+    Dim j As Long
+    Dim basket() As Variant
+    Dim m() As Variant
+
+    busy = True
+
+    m = shMonthUpdate.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
+
+    shMonthUpdate.Range("A2:O13") = m
+
+    shMonthUpdate.Range("U2:X1000").ClearContents
+    shMonthUpdate.Range("Z2:AC1000").ClearContents
+    shMonthUpdate.Range("R2:S1000").ClearContents
+    LoadSheet
+
+    basket = Utils.SHTp_get_block(shMonthUpdate.Range("U1"))
+'    shMonthView.Cells(32, 2) = basket(1, 1)
+'    shMonthView.Cells(32, 6) = basket(1, 2)
+'    shMonthView.Cells(32, 12) = basket(1, 3)
+'    shMonthView.Cells(32, 17) = basket(1, 4)
+    Call Me.print_basket
+
+    busy = 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 = Utils.SHTp_Get(shMonthUpdate.Name, 1, 27, True)
+    If Not Utils.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
+
+    busy = True
+
+    With shMonthView.Range("basket")
+        .ClearContents
+        For i = 1 To UBound(cust, 2)
+            .Cells(i, 1) = part.cbPart.Value
+            .Cells(i, 5) = cust(0, i)
+            .Cells(i, 11) = cust(1, i)
+            .Cells(i, 16) = CDbl(cust(2, i))
+        Next i
+    End With
+
+    shConfig.Range("new_part").Value = 1
+
+    '------copy revised basket to _month storage---------------------------------------------------
+
+    With shMonthView.Range("basket")
+        i = WorksheetFunction.CountA(.Resize(, 1))
+        If i = 0 Then Exit Sub
+
+        ReDim basket(i - 1, 3)
+
+        For i = 1 To .Rows.Count
+            basket(i - 1, 0) = .Cells(i, 1)
+            basket(i - 1, 1) = .Cells(i, 5)
+            basket(i - 1, 2) = .Cells(i, 11)
+            basket(i - 1, 3) = .Cells(i, 16) * 1
+        Next
+    End With
+
+    shMonthUpdate.Range("U2:AC100000").ClearContents
+    Call Utils.SHTp_DumpVar(basket, shMonthUpdate.Name, 2, 21, False, False, True)
+    Call Utils.SHTp_DumpVar(basket, shMonthUpdate.Name, 2, 26, False, False, True)
+
+    '------reset volume to copy base to forecsat and clear base------------------------------------
+
+    units = shMonthUpdate.Range("A2:E13").FormulaR1C1
+    price = shMonthUpdate.Range("F2:J13").FormulaR1C1
+    sales = shMonthUpdate.Range("K2:O13").FormulaR1C1
+    tunits = shMonthView.Range("tunits")
+    tprice = shMonthView.Range("tprice")
+    tsales = shMonthView.Range("tsales")
+    ReDim adjust(12)
+    For i = 1 To 12
+        'volume
+        units(i, 5) = 0 'units(i, 2)
+        units(i, 4) = 0 'units(i, 2)
+        units(i, 1) = 0
+        units(i, 2) = 0
+        units(i, 3) = 0
+        'sales
+        sales(i, 5) = 0 'sales(i, 2)
+        sales(i, 4) = 0 'sales(i, 2)
+        sales(i, 1) = 0
+        sales(i, 2) = 0
+        sales(i, 3) = 0
+        'price
+        price(i, 5) = 0 'price(i, 2)
+        price(i, 4) = 0 'price(i, 2)
+        price(i, 1) = 0
+        price(i, 2) = 0
+        price(i, 3) = 0
+    Next i
+    CrunchArray
+    BuildJson
+    SetSheet
+
+    '-------------push revised arrays back to _month, not revertable-------------------------------
+
+    shMonthUpdate.Range("A2:E13") = units
+    shMonthUpdate.Range("F2:J13") = price
+    shMonthUpdate.Range("K2:o13") = sales
+
+
+    'force basket to show to demonstrate the part was changed
+    shConfig.Range("show_basket").Value = 1
+    Call Me.print_basket
+    busy = False
+
+ End Sub
+
+Function newpart() As Boolean
+    newpart = shConfig.Range("new_part").Value = 1
+End Function
+
+Private Sub Worksheet_Deactivate()
+    Forecasting.shMonthView.Visible = IIf(shConfig.Range("debug_mode").Value, xlSheetVisible, xlSheetHidden)
+End Sub

Master Template.xlsm_EXPORTS/shOrders.cls

@@ -0,0 +1,114 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shOrders"
+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)
+    Dim pt As PivotTable
+    Set pt = ActiveSheet.PivotTables("ptOrders")
+    
+    Dim intersec As Range
+    Set intersec = Intersect(Target, pt.DataBodyRange)
+    
+    If intersec Is Nothing Then
+        Exit Sub
+    ElseIf intersec.address <> Target.address 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 pf As PivotField
+    Dim pi As PivotItem
+    
+    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)
+    
+    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_sql(ri(i).Name) & "'"
+        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(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
+
+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_json(ByVal text As String) As String
+
+    text = Replace(text, "'", "''")
+    text = Replace(text, """", "\""")
+    If text = "(blank)" Then text = ""
+    escape_json = text
+
+End Function
+
+Function escape_sql(ByVal text As String) As String
+
+    text = Replace(text, "'", "''")
+    text = Replace(text, """", """""")
+    If text = "(blank)" Then text = ""
+    escape_sql = text
+
+End Function
+
+

Master Template.xlsm_EXPORTS/shSupportingData.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shSupportingData"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

Master Template.xlsm_EXPORTS/shWalk.cls

@@ -0,0 +1,114 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shWalk"
+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)
+'    Dim pt As PivotTable
+'    Set pt = ActiveSheet.PivotTables("ptWalk")
+'    Dim intersec As Range
+'    Set intersec = Intersect(Target, pt.DataBodyRange)
+'
+'    If intersec Is Nothing Then
+'        Exit Sub
+'    ElseIf intersec.address <> Target.address 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 pf As PivotField
+'    Dim pi As PivotItem
+'
+'    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)
+'
+'    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_sql(ri(i).Name) & "'"
+'        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(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
+'
+'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_json(ByVal text As String) As String
+'
+'    text = Replace(text, "'", "''")
+'    text = Replace(text, """", "\""")
+'    If text = "(blank)" Then text = ""
+'    escape_json = text
+'
+'End Function
+'
+'Function escape_sql(ByVal text As String) As String
+'
+'    text = Replace(text, "'", "''")
+'    text = Replace(text, """", """""")
+'    If text = "(blank)" Then text = ""
+'    escape_sql = text
+'
+'End Function
+'
+'
+