Add code to do ship_date shifting. Workbook changes not finished yet.

Master Template.xlsm_EXPORTS/HttpHandler.bas

@@ -18,12 +18,12 @@ Function makeHttpRequest(method As String, route As String, doc As String, ByRef
 
     ' Inject the user's name and the current version of this file into the request body.
     Set json = JsonConverter.ParseJson(doc)
-    json("version") = shConfig.Range("version").Value
+    json("version") = shConfig.Range("version").value
     json("username") = Application.UserName
     doc = JsonConverter.ConvertToJson(json)
     
     Dim server As String
-    server = shConfig.Range("server").Value
+    server = shConfig.Range("server").value
 
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All

Master Template.xlsm_EXPORTS/JsonConverter.bas

@@ -588,7 +588,7 @@ Private Function json_ParseString(json_String As String, ByRef json_Index As Lon
                 ' Unicode character escape (e.g. \u00a9 = Copyright)
                 json_Index = json_Index + 1
                 json_Code = VBA.Mid$(json_String, json_Index, 4)
-                json_BufferAppend json_Buffer, VBA.ChrW(VBA.val("&h" + json_Code)), json_BufferPosition, json_BufferLength
+                json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength
                 json_Index = json_Index + 4
             End Select
         Case json_Quote
@@ -628,7 +628,7 @@ Private Function json_ParseNumber(json_String As String, ByRef json_Index As Lon
                 json_ParseNumber = json_Value
             Else
                 ' VBA.Val does not use regional settings, so guard for comma is not needed
-                json_ParseNumber = VBA.val(json_Value)
+                json_ParseNumber = VBA.Val(json_Value)
             End If
             Exit Function
         End If
@@ -987,7 +987,7 @@ Public Function ParseIso(utc_IsoString As String) As Date
                     utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0)
                 Case 2
                     ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
-                    utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.val(utc_OffsetParts(2))))
+                    utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2))))
                 End Select
 
                 If utc_NegativeOffset Then: utc_Offset = -utc_Offset
@@ -1003,7 +1003,7 @@ Public Function ParseIso(utc_IsoString As String) As Date
             ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0)
         Case 2
             ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
-            ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.val(utc_TimeParts(2))))
+            ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2))))
         End Select
 
         ParseIso = ParseUtc(ParseIso)

Master Template.xlsm_EXPORTS/Utils.bas

@@ -642,3 +642,51 @@ Public Function RangeToArray(inputRange As Range) As Variant()
 
 End Function
 
+Public 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
+
+Public 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
+
+Public 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
+
+Public 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/build.frm

@@ -29,11 +29,11 @@ End Sub
 
 Public Sub Initialize(part As String, billTo As String, shipTo As String)
     cbPart.list = RangeToArray(shSupportingData.ListObjects("ITEM").DataBodyRange)
-    cbPart.Value = part
+    cbPart.value = part
     cbBill.list = RangeToArray(shSupportingData.ListObjects("CUSTOMER").DataBodyRange)
-    cbBill.Value = billTo
+    cbBill.value = billTo
     cbShip.list = RangeToArray(shSupportingData.ListObjects("CUSTOMER").DataBodyRange)
-    cbShip.Value = shipTo
+    cbShip.value = shipTo
     
     useval = False
 End Sub

Master Template.xlsm_EXPORTS/changes.frm

@@ -16,7 +16,7 @@ Attribute VB_Exposed = False
 Private X As Variant
 
 Private Sub UserForm_Activate()
-    tbPrint.Value = ""
+    tbPrint.value = ""
     
     Dim errorMsg As String
     X = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & shData.Cells(2, 5) & """}}", errorMsg)
@@ -42,7 +42,7 @@ Private Sub lbHist_Change()
 
     For i = 0 To Me.lbHist.ListCount - 1
         If Me.lbHist.Selected(i) Then
-            Me.tbPrint.Value = X(i, 7)
+            Me.tbPrint.value = X(i, 7)
             Exit Sub
         End If
     Next i

Master Template.xlsm_EXPORTS/fpvt.frm

@@ -48,16 +48,16 @@ End Sub
 
 Private Sub butAdjust_Click()
     Dim errorMsg As String
-    If tbAPI.text = "" Then errorMsg = "No adjustments provided."
+    If tbapi.text = "" Then errorMsg = "No adjustments provided."
     If cbTAG.text = "" Then errorMsg = "No tag was selected."
-    If tbAPI.text = "" Then errorMsg = "No adjustements are ready."
+    If tbapi.text = "" Then errorMsg = "No adjustements are ready."
     
     If errorMsg <> "" Then
         MsgBox errorMsg, vbOKOnly Or vbExclamation
         Exit Sub
     End If
 
-    handler.request_adjust tbAPI.text, errorMsg
+    handler.request_adjust tbapi.text, errorMsg
     If errorMsg <> "" Then
         MsgBox errorMsg, vbOKOnly Or vbExclamation, "Adjustment was not made due to error."
         Exit Sub
@@ -79,13 +79,13 @@ Private Sub cbGoSheet_Click()
     Dim tags
     tags = RangeToArray(shConfig.ListObjects("TAGS").DataBodyRange)
     If UBound(tags, 1) = 1 Then
-        shMonthView.Range("MonthTag").Value = tags(1, 1)
+        shMonthView.Range("MonthTag").value = tags(1, 1)
     Else
-        shMonthView.Range("MonthTag").Value = ""
+        shMonthView.Range("MonthTag").value = ""
     End If
-    shMonthView.Range("MonthComment").Value = ""
+    shMonthView.Range("MonthComment").value = ""
-    shMonthView.Range("QtyPctChange").Value = 0
+    shMonthView.Range("QtyPctChange").value = 0
-    shMonthView.Range("PricePctChange").Value = 0
+    shMonthView.Range("PricePctChange").value = 0
     shMonthView.Visible = xlSheetVisible
     shMonthView.Select
     Me.Hide
@@ -93,10 +93,10 @@ End Sub
 
 Private Sub cbTAG_Change()
     Dim j As Object
-    If tbAPI.text = "" Then tbAPI.text = "{}"
+    If tbapi.text = "" Then tbapi.text = "{}"
-    Set j = JsonConverter.ParseJson(tbAPI.text)
+    Set j = JsonConverter.ParseJson(tbapi.text)
-    j("tag") = cbTAG.Value
+    j("tag") = cbTAG.value
-    tbAPI.text = JsonConverter.ConvertToJson(j)
+    tbapi.text = JsonConverter.ConvertToJson(j)
 End Sub
 
 Private Sub opEditPrice_Click()
@@ -148,22 +148,22 @@ Private Sub opPlugVol_Click()
 End Sub
 
 Private Sub sbpd_Change()
-    tbpd.Value = sbpd.Value
+    tbpd.value = sbpd.value
 End Sub
 
 Private Sub sbpp_Change()
-    tbpp.Value = sbpp.Value
+    tbpp.value = sbpp.value
 End Sub
 
 Private Sub sbpv_Change()
-    tbpv.Value = sbpv.Value
+    tbpv.value = sbpv.value
 End Sub
 
 Private Sub tbCOM_Change()
-    If tbAPI.text = "" Then tbAPI.text = "{}"
+    If tbapi.text = "" Then tbapi.text = "{}"
-    Set adjust = JsonConverter.ParseJson(tbAPI.text)
+    Set adjust = JsonConverter.ParseJson(tbapi.text)
     adjust("message") = tbCOM.text
-    tbAPI.text = JsonConverter.ConvertToJson(adjust)
+    tbapi.text = JsonConverter.ConvertToJson(adjust)
 End Sub
 
 Private Sub tbFcPrice_Change()
@@ -185,25 +185,25 @@ End Sub
 
 Private Sub tbpd_Change()
     If load_tb Then Exit Sub
-    If Not VBA.IsNumeric(tbpd.Value) Then Exit Sub
+    If Not VBA.IsNumeric(tbpd.value) Then Exit Sub
-    tbFcVal = (bVal + pVal) * (1 + tbpd.Value / 100)
+    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
+    If Not VBA.IsNumeric(tbpd.value) Then Exit Sub
-    tbFcPrice = (bPrc + pPrc) * (1 + tbpp.Value / 100)
+    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
+    If Not VBA.IsNumeric(tbpv.value) Then Exit Sub
-    tbFcVol = (bVol + pVol) * (1 + tbpv.Value / 100)
+    tbFcVol = (bVol + pVol) * (1 + tbpv.value / 100)
 End Sub
 
 Private Sub UserForm_Activate()
-    Me.Caption = "Forecast Adjust " & shConfig.Range("version").Value & "   Loading..."
+    Me.Caption = "Forecast Adjust " & shConfig.Range("version").value & "   Loading..."
     Me.mp.Visible = False
     Me.fraExit.Visible = False
 
@@ -211,7 +211,7 @@ Private Sub UserForm_Activate()
     Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", errorMsg)
     Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
 
-    Me.Caption = "Forecast Adjust " & shConfig.Range("version").Value
+    Me.Caption = "Forecast Adjust " & shConfig.Range("version").value
 
     If errorMsg <> "" Then
         fpvt.Hide
@@ -232,7 +232,7 @@ Private Sub UserForm_Activate()
     fVal = 0
     fVol = 0
     fPrc = 0
-    Me.tbAPI.Value = ""
+    Me.tbapi.value = ""
 
     If IsNull(sp("package")("totals")) Then
         MsgBox "An unexpected error has occurred when retrieving the scenario.", vbOKOnly Or vbExclamation, "Error"
@@ -326,9 +326,9 @@ Private Sub UserForm_Activate()
     End If
     
     '----------reset spinner buttons----------------------
-    sbpv.Value = 0
+    sbpv.value = 0
-    sbpp.Value = 0
+    sbpp.value = 0
-    sbpd.Value = 0
+    sbpd.value = 0
 
     Call handler.month_tosheet(month, basket)
     Application.StatusBar = False
@@ -422,9 +422,9 @@ Sub calc_val()
 
     Dim pchange As Double
 
-    If IsNumeric(tbFcVal.Value) Then
+    If IsNumeric(tbFcVal.value) Then
         'get textbox value
-        fVal = tbFcVal.Value
+        fVal = tbFcVal.value
         'do calculations
         aVal = fVal - bVal - pVal
 
@@ -486,12 +486,12 @@ Sub calc_val()
     End If
 
     'print json
-    tbAPI = JsonConverter.ConvertToJson(adjust)
+    tbapi = JsonConverter.ConvertToJson(adjust)
 End Sub
 
 Sub calc_price()
-    fVol = co_num(tbFcVol.Value, 0)
+    fVol = co_num(tbFcVol.value, 0)
-    fPrc = co_num(tbFcPrice.Value, 0)
+    fPrc = co_num(tbFcPrice.value, 0)
     'calc
     fVal = fPrc * fVol
     aVal = fVal - bVal - pVal
@@ -537,7 +537,7 @@ Sub calc_price()
     End If
 
     'print json
-    tbAPI = JsonConverter.ConvertToJson(adjust)
+    tbapi = JsonConverter.ConvertToJson(adjust)
 End Sub
 
 Function iter_def(ByVal iter As String) As String

Master Template.xlsm_EXPORTS/handler.bas

@@ -234,7 +234,7 @@ Sub load_config()
 
     Dim i As Integer
     '----server to use---------------------------------------------------------
-    handler.server = shConfig.Range("server").Value
+    handler.server = shConfig.Range("server").value
     '---basis------------------------------------------------------------------
     With shConfig.ListObjects("BASIS")
         For i = 1 To .DataBodyRange.Rows.Count
@@ -257,7 +257,7 @@ Sub load_config()
         Next
     End With
     '---plan version--------------------------------------------------------------
-    handler.plan = shConfig.Range("budget").Value
+    handler.plan = shConfig.Range("budget").value
 
 End Sub
 
@@ -357,9 +357,9 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
         .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("rebuild").value = 0
-        shConfig.Range("show_basket").Value = 0
+        shConfig.Range("show_basket").value = 0
-        shConfig.Range("new_part").Value = 0
+        shConfig.Range("new_part").value = 0
 
         shMonthView.LoadSheet
 

Master Template.xlsm_EXPORTS/openf.frm

@@ -18,12 +18,12 @@ Private Sub cbCancel_Click()
 End Sub
 
 Private Sub cbOK_Click()
-    If opDSM.Value Then
+    If opDSM.value Then
-        Call handler.pg_main_workset("quota_rep_descr", cbDSM.Value)
+        Call handler.pg_main_workset("quota_rep_descr", cbDSM.value)
-    ElseIf opDirector.Value Then
+    ElseIf opDirector.value Then
-        Call handler.pg_main_workset("director", cbDirector.Value)
+        Call handler.pg_main_workset("director", cbDirector.value)
-    ElseIf opSegment.Value Then
+    ElseIf opSegment.value Then
-        Call handler.pg_main_workset("segm", cbSegment.Value)
+        Call handler.pg_main_workset("segm", cbSegment.value)
     End If
     shOrders.PivotTables("ptOrders").PivotCache.Refresh
     openf.Hide
@@ -54,7 +54,7 @@ Private Sub opSegment_Click()
 End Sub
 
 Private Sub UserForm_Activate()
-    handler.server = shConfig.Range("server").Value
+    handler.server = shConfig.Range("server").value
     cbDSM.list = RangeToArray(shSupportingData.ListObjects("DSM").DataBodyRange)
     cbDirector.list = RangeToArray(shConfig.ListObjects("DIRECTORS").DataBodyRange)
     cbSegment.list = RangeToArray(shConfig.ListObjects("SEGMENTS").DataBodyRange)

Master Template.xlsm_EXPORTS/shConfig.cls

@@ -12,7 +12,7 @@ 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
+    If shConfig.Range("debug_mode").value Then
         shConfig.Visible = xlSheetVisible
         'shData.Visible = xlSheetVisible
         shMonthView.Visible = xlSheetVisible

Master Template.xlsm_EXPORTS/shMonthView.cls

@@ -30,7 +30,7 @@ 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)
+        .value = WorksheetFunction.Max(-0.1, .value - 0.01)
     End With
     MPP_Change
 End Sub
@@ -39,7 +39,7 @@ 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)
+        .value = WorksheetFunction.Min(0.1, .value + 0.01)
     End With
     MPP_Change
 End Sub
@@ -70,7 +70,7 @@ 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)
+        .value = WorksheetFunction.Max(-0.1, .value - 0.01)
     End With
     MPV_Change
 End Sub
@@ -79,7 +79,7 @@ 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)
+        .value = WorksheetFunction.Min(0.1, .value + 0.01)
     End With
     MPV_Change
 End Sub
@@ -107,8 +107,8 @@ Private Sub MPV_Change()
 End Sub
 
 Public Sub ToggleVolumePrice()
-    shMonthView.Range("MonthAdjustVolume").Value = (shMonthView.Range("MonthAdjustVolume").Value <> True)
+    shMonthView.Range("MonthAdjustVolume").value = (shMonthView.Range("MonthAdjustVolume").value <> True)
-    shMonthView.Range("MonthAdjustPrice").Value = Not shMonthView.Range("MonthAdjustVolume").Value
+    shMonthView.Range("MonthAdjustPrice").value = Not shMonthView.Range("MonthAdjustVolume").value
 End Sub
 
 Private Sub Worksheet_Change(ByVal Target As Range)
@@ -139,7 +139,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
     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 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
@@ -149,7 +149,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
 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
+    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
@@ -158,7 +158,7 @@ End Sub
 
 
 Sub picker_shortcut()
-    If IntersectsWith(Selection, Range("basket")) And shConfig.Range("show_basket").Value = 1 Then
+    If IntersectsWith(Selection, Range("basket")) And shConfig.Range("show_basket").value = 1 Then
         Call Me.basket_pick(Selection)
     End If
 
@@ -421,7 +421,7 @@ Private Sub BuildJson()
         Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy"",""plan""]")
         np("source") = "adj"
         np("type") = "new_basket"
-        np("tag") = shMonthView.Range("MonthTag").Value
+        np("tag") = shMonthView.Range("MonthTag").value
         Set m = JsonConverter.ParseJson("{}")
     End If
 
@@ -431,7 +431,7 @@ Private Sub BuildJson()
                 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))
+                Set m(shMonthView.Range("OrderMonths").Cells(pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
             End If
         Else
             'if something is changing
@@ -472,10 +472,10 @@ Private Sub BuildJson()
 
     If Me.newpart Then
         Set np("months") = JsonConverter.ParseJson(JsonConverter.ConvertToJson(m))
-        np("newpart") = shMonthView.Range("basket").Cells(1, 1).Value
+        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
+        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) & "]")
@@ -556,13 +556,13 @@ Sub reset()
 End Sub
 
 Sub switch_basket()
-    shConfig.Range("show_basket").Value = 1 - shConfig.Range("show_basket").Value
+    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
+    If shConfig.Range("show_basket").value = 0 Then
         busy = True
         shMonthView.Range("basket").ClearContents
         busy = False
@@ -577,10 +577,10 @@ Sub print_basket()
 
     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, 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, 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, 10).value = basket(i, 3)
-        shMonthView.Range("basket").Resize(1, 1).Offset(i - 2, 15).Value = basket(i, 4)
+        shMonthView.Range("basket").Resize(1, 1).Offset(i - 2, 15).value = basket(i, 4)
     Next i
 
     busy = False
@@ -597,9 +597,9 @@ Sub basket_pick(ByRef Target As Range)
         If build.useval Then
             busy = True
 
-            .Cells(Target.row + i, 2) = build.cbPart.Value
+            .Cells(Target.row + i, 2) = build.cbPart.value
-            .Cells(Target.row + i, 6) = rev_cust(build.cbBill.Value)
+            .Cells(Target.row + i, 6) = rev_cust(build.cbBill.value)
-            .Cells(Target.row + i, 12) = rev_cust(build.cbShip.Value)
+            .Cells(Target.row + i, 12) = rev_cust(build.cbShip.value)
             busy = False
             GetEditBasket Selection
 
@@ -712,7 +712,7 @@ Sub post_adjust()
         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 IsEmpty(shMonthView.Range("MonthTag").value) Then msg = "You need to specify a tag for this update."
 
     If msg <> "" Then
         MsgBox msg, vbOKOnly Or vbExclamation
@@ -724,8 +724,8 @@ Sub post_adjust()
 
     If Me.newpart Then
         Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(2, 16))
-        adjust("message") = shMonthView.Range("MonthComment").Value
+        adjust("message") = shMonthView.Range("MonthComment").value
-        adjust("tag") = shMonthView.Range("MonthTag").Value
+        adjust("tag") = shMonthView.Range("MonthTag").value
         jdoc = JsonConverter.ConvertToJson(adjust)
         
         Dim errorMsg As String
@@ -739,8 +739,8 @@ Sub post_adjust()
         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("message") = shMonthView.Range("MonthComment").value
-                adjust("tag") = shMonthView.Range("MonthTag").Value
+                adjust("tag") = shMonthView.Range("MonthTag").value
                 jdoc = JsonConverter.ConvertToJson(adjust)
                 handler.request_adjust jdoc, errorMsg
                 If errorMsg <> "" Then
@@ -760,7 +760,7 @@ End Sub
 
 Sub build_new()
 
-    shConfig.Range("rebuild").Value = 1
+    shConfig.Range("rebuild").value = 1
     Dim i As Long
     Dim j As Long
     Dim basket() As Variant
@@ -824,14 +824,14 @@ Sub new_part()
     With shMonthView.Range("basket")
         .ClearContents
         For i = 1 To UBound(cust, 2)
-            .Cells(i, 1) = part.cbPart.Value
+            .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
+    shConfig.Range("new_part").value = 1
 
     '------copy revised basket to _month storage---------------------------------------------------
 
@@ -894,16 +894,16 @@ Sub new_part()
 
 
     'force basket to show to demonstrate the part was changed
-    shConfig.Range("show_basket").Value = 1
+    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
+    newpart = shConfig.Range("new_part").value = 1
 End Function
 
 Private Sub Worksheet_Deactivate()
-    Forecasting.shMonthView.Visible = IIf(shConfig.Range("debug_mode").Value, xlSheetVisible, xlSheetHidden)
+    Forecasting.shMonthView.Visible = IIf(shConfig.Range("debug_mode").value, xlSheetVisible, xlSheetHidden)
 End Sub

Master Template.xlsm_EXPORTS/shOrders.cls

@@ -99,50 +99,3 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
     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/shShipments.cls

@@ -0,0 +1,144 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shShipments"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True
+Option Explicit
+
+Dim selectedSeason As Integer
+Dim selectedMonth As Integer
+
+Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
+    Dim pt As PivotTable
+    Set pt = ActiveSheet.PivotTables("ptShipments")
+
+    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
+    
+    If Target.value = "" Then
+        MsgBox "You cannot shift an empty cell.", vbOKOnly + vbExclamation
+        Exit Sub
+    End If
+
+    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
+
+    ' Serialize the report filters in SQL and JSON format.
+    pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
+    pt.PivotCache.Refresh
+
+    Dim segmSql As String
+    Dim segmJSql As String
+    segmSql = "segm IN ("
+    segmJSql = """segm"": ["
+
+    Set pf = pt.PivotFields("Segment")
+    For Each pi In pf.PivotItems
+        If pi.Visible Then
+            If Right(segmSql, 1) <> "(" Then
+                segmSql = segmSql & ", "
+                segmJSql = segmJSql & ", "
+            End If
+            segmSql = segmSql & "'" & escape_sql(pi.Name) & "'"
+            segmJSql = segmJSql & """" & escape_json(pi.Name) & """"
+        End If
+    Next
+    segmSql = segmSql & ")"
+    segmJSql = segmJSql & "]"
+
+    ' Serialize the row and column items in SQL and JSON format.
+    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
+
+    Dim idx As Integer
+    idx = IIf(Right(segmSql, 2) = "()", 0, 1)
+
+    handler.sql = IIf(idx = 0, "", segmSql)
+    handler.jsql = IIf(idx = 0, "", segmJSql)
+    ReDim handler.sc(ri.Count + ci.Count + idx, 1)
+
+    If idx = 1 Then
+        idx = 0
+        handler.sc(idx, 0) = "segm"
+        handler.sc(idx, 1) = Mid(segmJSql, 9)
+    End If
+
+    Dim key As String
+    Dim value As Variant
+    
+    For i = 1 To ri.Count
+        key = ri(i).Parent.Name
+        value = ri(i).value
+        
+        If handler.sql <> "" Then handler.sql = handler.sql & vbCrLf & "AND "
+        If handler.sql <> "" Then handler.jsql = handler.jsql & vbCrLf & ","
+        handler.sql = handler.sql & key & " = '" & escape_sql(value) & "'"
+        handler.jsql = handler.jsql & """" & key & """:""" & escape_json(value) & """"
+        idx = idx + 1
+        handler.sc(idx, 0) = key
+        handler.sc(idx, 1) = value
+    Next i
+
+    For i = 1 To ci.Count
+        key = ci(i).Parent.Name
+        value = ci(i).value
+        
+        If handler.sql <> "" Then handler.sql = handler.sql & vbCrLf & "AND "
+        If handler.sql <> "" Then handler.jsql = handler.jsql & vbCrLf & ","
+        handler.sql = handler.sql & key & " = '" & escape_sql(value) & "'"
+        handler.jsql = handler.jsql & """" & key & """:""" & escape_json(value) & """"
+        idx = idx + 1
+        handler.sc(idx, 0) = key
+        handler.sc(idx, 1) = value
+        
+        If key = "ship_season" Then selectedSeason = CInt(value)
+        If key = "ship_month" Then selectedMonth = CInt(Left(value, 2))
+    Next
+
+    scenario = "{" & handler.jsql & "}"
+
+    If selectedSeason = 0 Or selectedMonth = 0 Then
+        MsgBox "Invalid pivot table setup. Make sure SHIP_SEASON and SHIP_MONTH are set as pivot table columns.", vbOKOnly + vbExclamation
+        Exit Sub
+    End If
+    
+    Call handler.load_config
+    With shipDateShifter
+        .lbSDET.list = handler.sc
+        .selectedSeason = selectedSeason
+        .selectedMonth = selectedMonth
+        .currentValue = Target.value
+        .numberFormat = IIf(df.numberFormat Like "*$*", "$#,##0", "#,##0")
+        .Show
+    End With
+    
+End Sub
+
+

Master Template.xlsm_EXPORTS/shipDateShifter.frm

@@ -0,0 +1,424 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} shipDateShifter 
+   Caption         =   "Ship Date Shifting"
+   ClientHeight    =   5205
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   18375
+   OleObjectBlob   =   "shipDateShifter.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "shipDateShifter"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public selectedSeason As Integer
+Public selectedMonth As Integer
+Public currentValue As Double
+Public numberFormat As String
+
+Private Sub cmdCancel_Click()
+    Unload Me
+End Sub
+
+Private Sub cmdOK_Click()
+    'build json
+    Dim adjust As Object
+    Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & ", ""distributions"":[]}")
+    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") = "shift"
+    adjust("type") = "shift_ship_dates"
+    adjust("message") = txtComment.text
+    adjust("tag") = "Shift Shipping"
+    adjust("version") = handler.plan
+    
+    Dim distribution As Object
+    Dim distributed As Double
+    Dim month As MSForms.TextBox
+    Dim m As Integer
+    For m = 1 To 12
+        Set month = txtMonth(selectedSeason, m)
+        If month.text <> "" Then
+            If m <> selectedMonth Then distributed = distributed + Val(RemoveFormat(month.text))
+            Set distribution = JsonConverter.ParseJson( _
+                "{""ship_season"":" & selectedSeason & "," & _
+                " ""ship_month"": """ & Me.Controls("lblShipMonth" & Format(m, "00")).Caption & """," & _
+                " ""pct"":" & Val(Replace(lblPctMonth(selectedSeason, m).Caption, "%", "")) / 100 & _
+                "}")
+            adjust("distributions").Add distribution
+        End If
+    Next
+    
+    For m = 1 To 12
+        Set month = txtMonth(selectedSeason + 1, m)
+        If month.text <> "" Then
+            distributed = distributed + Val(RemoveFormat(month.text))
+            Set distribution = JsonConverter.ParseJson( _
+                "{""ship_season"":" & selectedSeason + 1 & "," & _
+                " ""ship_month"": """ & Me.Controls("lblShipMonth" & Format(m, "00")).Caption & """," & _
+                " ""pct"":" & Val(Replace(lblPctMonth(selectedSeason + 1, m).Caption, "%", "")) / 100 & _
+                "}")
+            adjust("distributions").Add distribution
+        End If
+    Next
+    
+    If distributed = 0 Then
+        MsgBox "No shifts were specified.", vbOKOnly + vbInformation
+        Exit Sub
+    End If
+    
+    Dim errorMsg As String
+    Dim json As Object
+    Set json = makeHttpRequest("POST", "shift_ship_dates", JsonConverter.ConvertToJson(adjust), errorMsg)
+
+    If errorMsg <> "" Then
+        MsgBox errorMsg, vbOKOnly + vbExclamation, "Couldn't shift the selected ship dates."
+        Exit Sub
+    End If
+    
+    ReDim res(json("x").Count - 1, 34)
+
+    Dim i As Long
+    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
+
+    errorMsg = ""
+    
+    i = shData.UsedRange.Rows.Count + 1
+    Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
+    shShipments.PivotTables("ptShipments").PivotCache.Refresh
+
+End Sub
+
+Private Sub UserForm_Activate()
+    Me.Caption = "Ship Date Shifting " & shConfig.Range("version").value
+
+    Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
+
+    With txtSelectedMonth
+        .text = Format(currentValue, numberFormat)
+        .BackColor = &H80000018
+        .Enabled = False
+    End With
+
+    lblSeasonCurrent.Caption = selectedSeason
+    lblSeasonNext.Caption = selectedSeason + 1
+End Sub
+
+' Control Accessors
+Private Function txtSelectedMonth() As MSForms.TextBox
+    Set txtSelectedMonth = txtMonth(selectedSeason, selectedMonth)
+End Function
+
+Private Function txtMonth(season As Integer, month As Integer) As MSForms.TextBox
+    Set txtMonth = Me.Controls("txt" & IIf(season = selectedSeason, "Current", "Next") & Format(month, "00"))
+End Function
+
+Private Function lblPctSelectedMonth() As MSForms.Label
+    Set lblPctSelectedMonth = lblPctMonth(selectedSeason, selectedMonth)
+End Function
+
+Private Function lblPctMonth(season As Integer, month As Integer) As MSForms.Label
+    Set lblPctMonth = Me.Controls("lblPct" & IIf(season = selectedSeason, "Current", "Next") & Format(month, "00"))
+End Function
+
+
+Private Sub RemoveFormatting(txtBx As MSForms.TextBox)
+    txtBx.text = RemoveFormat(txtBx.text)
+End Sub
+
+Private Function RemoveFormat(text As String)
+    RemoveFormat = Replace(Replace(text, "$", ""), ",", "")
+End Function
+
+Private Sub ApplyFormatting(txtBx As MSForms.TextBox)
+    txtBx.text = Format(txtBx.text, numberFormat)
+End Sub
+
+
+Private Function Recalculate(updated As MSForms.TextBox) As Boolean
+    Dim month As MSForms.TextBox
+    Dim distributed As Double
+    Dim before As Double
+    Dim m As Integer
+    For m = 1 To 12
+        Set month = txtMonth(selectedSeason, m)
+        If m < selectedMonth Then before = before + Val(RemoveFormat(month.text))
+        If m <> selectedMonth Then distributed = distributed + Val(RemoveFormat(month.text))
+        
+        distributed = distributed + Val(RemoveFormat(txtMonth(selectedSeason + 1, m).text))
+    Next
+    
+    Dim remaining As Double
+    remaining = Val(RemoveFormat(txtSelectedMonth.text))
+
+    If remaining = 0 And distributed > currentValue Then
+        MsgBox "You cannot shift more than you started with.", vbOKOnly + vbExclamation
+        Recalculate = True  ' Failure. Set Cancel=True to stop leaving the textbox.
+        Exit Function
+    ElseIf distributed <= currentValue Then
+        txtSelectedMonth.text = currentValue - distributed
+    Else
+        updated.text = txtSelectedMonth.text
+        txtSelectedMonth.text = 0
+    End If
+    
+    ApplyFormatting updated
+    ApplyFormatting txtSelectedMonth
+    lblWarning.Visible = before > 0
+    
+    For m = 1 To 12
+        If txtMonth(selectedSeason, m).text = "" Then
+            lblPctMonth(selectedSeason, m).Caption = ""
+        Else
+            lblPctMonth(selectedSeason, m).Caption = Format(txtMonth(selectedSeason, m).text / currentValue, "0%")
+        End If
+        If txtMonth(selectedSeason + 1, m).text = "" Then
+            lblPctMonth(selectedSeason + 1, m).Caption = ""
+        Else
+            lblPctMonth(selectedSeason + 1, m).Caption = Format(txtMonth(selectedSeason + 1, m).text / currentValue, "0%")
+        End If
+    Next
+    Recalculate = False ' Success
+End Function
+
+
+' Remove formatting before editing a textbox. After editing, restore formatting,
+' and recalculate the selected month's value.
+Private Sub txtCurrent01_Enter()
+    RemoveFormatting txtCurrent01
+End Sub
+
+Private Sub txtCurrent01_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent01)
+End Sub
+
+Private Sub txtCurrent02_Enter()
+    RemoveFormatting txtCurrent02
+End Sub
+
+Private Sub txtCurrent02_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent02)
+End Sub
+
+Private Sub txtCurrent03_Enter()
+    RemoveFormatting txtCurrent03
+End Sub
+
+Private Sub txtCurrent03_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent03)
+End Sub
+
+Private Sub txtCurrent04_Enter()
+    RemoveFormatting txtCurrent04
+End Sub
+
+Private Sub txtCurrent04_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent04)
+End Sub
+
+Private Sub txtCurrent05_Enter()
+    RemoveFormatting txtCurrent05
+End Sub
+
+Private Sub txtCurrent05_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent05)
+End Sub
+
+Private Sub txtCurrent06_Enter()
+    RemoveFormatting txtCurrent06
+End Sub
+
+Private Sub txtCurrent06_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent06)
+End Sub
+
+Private Sub txtCurrent07_Enter()
+    RemoveFormatting txtCurrent07
+End Sub
+
+Private Sub txtCurrent07_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent07)
+End Sub
+
+Private Sub txtCurrent08_Enter()
+    RemoveFormatting txtCurrent08
+End Sub
+
+Private Sub txtCurrent08_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent08)
+End Sub
+
+Private Sub txtCurrent09_Enter()
+    RemoveFormatting txtCurrent09
+End Sub
+
+Private Sub txtCurrent09_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent09)
+End Sub
+
+Private Sub txtCurrent10_Enter()
+    RemoveFormatting txtCurrent10
+End Sub
+
+Private Sub txtCurrent10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent10)
+End Sub
+
+Private Sub txtCurrent11_Enter()
+    RemoveFormatting txtCurrent11
+End Sub
+
+Private Sub txtCurrent11_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent11)
+End Sub
+
+Private Sub txtCurrent12_Enter()
+    RemoveFormatting txtCurrent12
+End Sub
+
+Private Sub txtCurrent12_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtCurrent12)
+End Sub
+
+Private Sub txtNext01_Enter()
+    RemoveFormatting txtNext01
+End Sub
+
+Private Sub txtNext01_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext01)
+End Sub
+
+Private Sub txtNext02_Enter()
+    RemoveFormatting txtNext02
+End Sub
+
+Private Sub txtNext02_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext02)
+End Sub
+
+Private Sub txtNext03_Enter()
+    RemoveFormatting txtNext03
+End Sub
+
+Private Sub txtNext03_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext03)
+End Sub
+
+Private Sub txtNext04_Enter()
+    RemoveFormatting txtNext04
+End Sub
+
+Private Sub txtNext04_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext04)
+End Sub
+
+Private Sub txtNext05_Enter()
+    RemoveFormatting txtNext05
+End Sub
+
+Private Sub txtNext05_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext05)
+End Sub
+
+Private Sub txtNext06_Enter()
+    RemoveFormatting txtNext06
+End Sub
+
+Private Sub txtNext06_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext06)
+End Sub
+
+Private Sub txtNext07_Enter()
+    RemoveFormatting txtNext07
+End Sub
+
+Private Sub txtNext07_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext07)
+End Sub
+
+Private Sub txtNext08_Enter()
+    RemoveFormatting txtNext08
+End Sub
+
+Private Sub txtNext08_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext08)
+End Sub
+
+Private Sub txtNext09_Enter()
+    RemoveFormatting txtNext09
+End Sub
+
+Private Sub txtNext09_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext09)
+End Sub
+
+Private Sub txtNext10_Enter()
+    RemoveFormatting txtNext10
+End Sub
+
+Private Sub txtNext10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext10)
+End Sub
+
+Private Sub txtNext11_Enter()
+    RemoveFormatting txtNext11
+End Sub
+
+Private Sub txtNext11_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext11)
+End Sub
+
+Private Sub txtNext12_Enter()
+    RemoveFormatting txtNext12
+End Sub
+
+Private Sub txtNext12_Exit(ByVal Cancel As MSForms.ReturnBoolean)
+    Cancel = Recalculate(txtNext12)
+End Sub
+
+
+
+
+

index.js

@@ -365,3 +365,19 @@ server.post('/new_basket', bodyParser.json(), function(req, res) {
       Postgres.FirstRow(sql, res)
   });
 })
+
+server.post('/shift_ship_dates', bodyParser.json(), function(req, res) {
+  process_route('POST /shift_ship_dates', 'Change ship dates to level out production.', './route_sql/shift_ship_date.sql', req, res,
+    function(sql) {
+      var where = build_where(req, res);
+      if (!where) return;
+
+      req.body.stamp = new Date().toISOString()
+      sql = sql.replace(new RegExp("where_clause", 'g'), where);
+      sql = sql.replace(new RegExp("replace_request", 'g'), JSON.stringify(req.body));
+      sql = sql.replace(new RegExp("replace_version", 'g'), req.body.scenario.version);
+      sql = sql.replace(new RegExp("replace_source", 'g'), req.body.source);
+      sql = sql.replace(new RegExp("replace_iterdef", 'g'), JSON.stringify(req.body));
+      Postgres.FirstRow(sql, res)
+  });
+})

route_sql/shift_ship_date.sql

@@ -0,0 +1,477 @@
+-- Connection: usmidsap02.ubm
+WITH
+/*
+the volume must be expressed in terms of units, since that is what it will be scaling
+*/
+input AS (
+    select $$replace_request$$::json spec
+)
+-- select 'input', * from input
+--
+,target as (
+    select
+        ship_season, ship_month, pct
+    from
+        input i,
+        json_to_recordset(i.spec->'distributions') AS x(ship_season int, ship_month text, pct numeric)
+)
+-- select 'target', * from target
+--
+,mseq AS (
+    SELECT * FROM
+    (
+        VALUES
+         ('01 - Jun',  1,  6, -1)
+        ,('02 - Jul',  2,  7, -1)
+        ,('03 - Aug',  3,  8, -1)
+        ,('04 - Sep',  4,  9, -1)
+        ,('05 - Oct',  5, 10, -1)
+        ,('06 - Nov',  6, 11, -1)
+        ,('07 - Dec',  7, 12, -1)
+        ,('08 - Jan',  8,  1,  0)
+        ,('09 - Feb',  9,  2,  0)
+        ,('10 - Mar', 10,  3,  0)
+        ,('11 - Apr', 11,  4,  0)
+        ,('12 - May', 12,  5,  0)
+    ) x(m,s,cal,yr)
+)
+-- select 'mseq', * from mseq
+--
+,basemix AS (
+    SELECT
+         fspr
+        ,plnt
+        ,promo
+        ,terms
+        ,bill_cust_descr
+        ,ship_cust_descr
+        ,dsm
+        ,quota_rep_descr
+        ,director
+        ,billto_group
+        ,shipto_group
+        ,chan
+        ,chansub
+        ,chan_retail
+        ,part
+        ,part_descr
+        ,part_group
+        ,branding
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        ,segm
+        ,substance
+        ,fs_line
+        ,r_currency
+        ,coalesce(r_rate,1) as r_rate
+        ,c_currency
+        ,coalesce(c_rate,1) as c_rate
+        ,sum(coalesce(units,0)) units
+        ,sum(coalesce(value_loc,0)) value_loc
+        ,sum(coalesce(value_usd,0)) value_usd
+        ,sum(coalesce(cost_loc,0)) cost_loc
+        ,sum(coalesce(cost_usd,0)) cost_usd
+        ,sum(coalesce(pounds,0)) pounds
+        ,calc_status
+        ,flag
+        ,order_date
+        ,order_month
+        ,order_season
+        ,request_date
+        ,request_month
+        ,request_season
+        ,ship_date
+        ,ship_month
+        ,ship_season
+    FROM
+        rlarp.osm_pool
+    WHERE
+        -----------------scenario----------------------------
+        where_clause
+        -----------------additional params-------------------
+        AND order_date <= ship_date
+    GROUP BY
+        fspr
+        ,plnt
+        ,promo
+        ,terms
+        ,bill_cust_descr
+        ,ship_cust_descr
+        ,dsm
+        ,quota_rep_descr
+        ,director
+        ,billto_group
+        ,shipto_group
+        ,chan
+        ,chansub
+        ,chan_retail
+        ,part
+        ,part_descr
+        ,part_group
+        ,branding
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        ,segm
+        ,substance
+        ,fs_line
+        ,r_currency
+        ,r_rate
+        ,c_currency
+        ,c_rate
+        ,calc_status
+        ,flag
+        ,order_date
+        ,order_month
+        ,order_season
+        ,request_date
+        ,request_month
+        ,request_season
+        ,ship_date
+        ,ship_month
+        ,ship_season
+)
+-- select 'basemix', * from basemix
+--
+,subtractions AS (
+    SELECT
+         fspr
+        ,plnt
+        ,promo
+        ,terms
+        ,bill_cust_descr
+        ,ship_cust_descr
+        ,dsm
+        ,quota_rep_descr
+        ,director
+        ,billto_group
+        ,shipto_group
+        ,chan
+        ,chansub
+        ,chan_retail
+        ,part
+        ,part_descr
+        ,part_group
+        ,branding
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        ,segm
+        ,substance
+        ,fs_line
+        ,r_currency
+        ,r_rate
+        ,c_currency
+        ,c_rate
+        ,-(1 - target.pct) * units as units
+        ,-(1 - target.pct) * value_loc as value_loc
+        ,-(1 - target.pct) * value_usd as value_usd
+        ,-(1 - target.pct) * cost_loc as cost_loc
+        ,-(1 - target.pct) * cost_usd as cost_usd
+        ,-(1 - target.pct) * pounds as pounds
+        ,calc_status
+        ,flag
+        ,order_date
+        ,order_month
+        ,order_season
+        ,request_date
+        ,request_month
+        ,request_season
+        ,ship_date
+        ,basemix.ship_month
+        ,basemix.ship_season
+    FROM basemix
+    INNER JOIN target ON
+        basemix.ship_season = target.ship_season AND
+        basemix.ship_month = target.ship_month
+)
+-- select 'subtraction', * from subtraction
+--
+,additions AS (
+    SELECT
+         fspr
+        ,plnt
+        ,promo
+        ,terms
+        ,bill_cust_descr
+        ,ship_cust_descr
+        ,dsm
+        ,quota_rep_descr
+        ,director
+        ,billto_group
+        ,shipto_group
+        ,chan
+        ,chansub
+        ,chan_retail
+        ,part
+        ,part_descr
+        ,part_group
+        ,branding
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        ,segm
+        ,substance
+        ,fs_line
+        ,r_currency
+        ,r_rate
+        ,c_currency
+        ,c_rate
+        ,t.pct * coalesce(units) as units
+        ,t.pct * coalesce(value_loc) as value_loc
+        ,t.pct * coalesce(value_usd) as value_usd
+        ,t.pct * coalesce(cost_loc) as cost_loc
+        ,t.pct * coalesce(cost_usd) as cost_usd
+        ,t.pct * coalesce(pounds) as pounds
+        ,calc_status
+        ,flag
+        ,order_date
+        ,order_month
+        ,order_season
+        ,request_date
+        ,request_month
+        ,request_season
+        -- These case statements fix the situation where a ship date was specified that is earlier than
+        -- the order date. If that happens, the new ship date becomes order date + 15 days. The case
+        -- statements also handle rolling over to the next month or season.
+        ,case
+        when t.ship_season <= b.order_season AND t.ship_month < b.order_month then b.order_date + 15
+        else make_date(t.ship_season, tMonths.cal, 1)
+        end as ship_date
+        ,case
+        when t.ship_season <= b.order_season AND t.ship_month < b.order_month then bMonths.m
+        else t.ship_month
+        end as ship_month
+        ,case
+        when t.ship_season <= b.order_season AND t.ship_month < b.order_month then
+            case
+            when b.order_month > bMonths.m then b.order_season + 1 -- May-to-June rollover
+            else b.order_season
+            end
+        else t.ship_season
+        end as ship_season
+    FROM basemix b
+    LEFT OUTER JOIN target t ON
+        b.ship_season <> t.ship_season OR
+        b.ship_month <> t.ship_month
+    INNER JOIN mseq bMonths ON
+        EXTRACT (month FROM (b.order_date + 15)) = bMonths.cal
+    INNER JOIN mseq tMonths ON
+        t.ship_month = tMonths.m
+)
+-- select 'additions', * from additions
+--
+,log AS (
+    INSERT INTO rlarp.osm_log(doc) SELECT $$replace_iterdef$$::jsonb doc RETURNING *
+)
+-- select 'log', * from log
+--
+,final AS (
+    SELECT
+        fspr
+        ,plnt
+        ,promo
+        ,terms
+        ,bill_cust_descr
+        ,ship_cust_descr
+        ,dsm
+        ,quota_rep_descr
+        ,director
+        ,billto_group
+        ,shipto_group
+        ,chan
+        ,chansub
+        ,chan_retail
+        ,part
+        ,part_descr
+        ,part_group
+        ,branding
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        ,segm
+        ,substance
+        ,fs_line
+        ,r_currency
+        ,r_rate
+        ,c_currency
+        ,c_rate
+        ,units
+        ,value_loc
+        ,value_usd
+        ,cost_loc
+        ,cost_usd
+        ,calc_status
+        ,flag
+        ,order_date
+        ,order_month
+        ,order_season
+        ,request_date
+        ,request_month
+        ,request_season
+        ,ship_date
+        ,ship_month
+        ,ship_season
+        ,'replace_version' "version"
+        ,'replace_source' iter
+        ,log.id
+        ,COALESCE(log.doc->>'tag','Volume') "tag"
+        ,log.doc->>'message' "comment"
+        ,log.doc->>'type' module
+        ,pounds
+FROM subtractions
+CROSS JOIN log
+UNION ALL
+    SELECT
+        fspr
+        ,plnt
+        ,promo
+        ,terms
+        ,bill_cust_descr
+        ,ship_cust_descr
+        ,dsm
+        ,quota_rep_descr
+        ,director
+        ,billto_group
+        ,shipto_group
+        ,chan
+        ,chansub
+        ,chan_retail
+        ,part
+        ,part_descr
+        ,part_group
+        ,branding
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        ,segm
+        ,substance
+        ,fs_line
+        ,r_currency
+        ,r_rate
+        ,c_currency
+        ,c_rate
+        ,units
+        ,value_loc
+        ,value_usd
+        ,cost_loc
+        ,cost_usd
+        ,calc_status
+        ,flag
+        ,order_date
+        ,order_month
+        ,order_season
+        ,request_date
+        ,request_month
+        ,request_season
+        ,ship_date
+        ,ship_month
+        ,ship_season
+        ,'replace_version' "version"
+        ,'replace_source' iter
+        ,log.id
+        ,COALESCE(log.doc->>'tag','Volume') "tag"
+        ,log.doc->>'message' "comment"
+        ,log.doc->>'type' module
+        ,pounds
+FROM additions
+CROSS JOIN log
+)
+-- select 'final', * from final
+--
+, ins AS (
+    INSERT INTO rlarp.osm_pool SELECT * FROM final RETURNING *
+)
+,insagg AS (
+    SELECT
+        ---------customer info-----------------
+         bill_cust_descr
+        ,billto_group
+        ,ship_cust_descr
+        ,shipto_group
+        ,quota_rep_descr
+        ,director
+        ,segm
+        ,substance
+        ,chan
+        ,chansub
+        ---------product info------------------
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        --,brand
+        --,part_family
+        ,part_group
+        ,branding
+        --,color
+        ,part_descr
+        ---------dates-------------------------
+        ,order_season
+        ,order_month
+        ,ship_season
+        ,ship_month
+        ,request_season
+        ,request_month
+        ,promo
+        ,version
+        ,iter
+        ,logid
+        ,tag
+        ,comment
+        --------values-------------------------
+        ,sum(value_loc) value_loc
+        ,sum(value_usd) value_usd
+        ,sum(cost_loc) cost_loc
+        ,sum(cost_usd) cost_usd
+        ,sum(units) units
+        ,sum(pounds) pounds
+    FROM
+        ins
+    GROUP BY
+        ---------customer info-----------------
+         bill_cust_descr
+        ,billto_group
+        ,ship_cust_descr
+        ,shipto_group
+        ,quota_rep_descr
+        ,director
+        ,segm
+        ,substance
+        ,chan
+        ,chansub
+        ---------product info------------------
+        ,majg_descr
+        ,ming_descr
+        ,majs_descr
+        ,mins_descr
+        --,brand
+        --,part_family
+        ,part_group
+        ,branding
+        --,color
+        ,part_descr
+        ---------dates-------------------------
+        ,order_season
+        ,order_month
+        ,ship_season
+        ,ship_month
+        ,request_season
+        ,request_month
+        ,promo
+        ,version
+        ,iter
+        ,logid
+        ,tag
+        ,comment
+)
+-- select 'insagg', * from insagg
+--
+SELECT json_agg(row_to_json(insagg)) x from insagg