From 9933e66c77ac193f4ee1306f22485a06adb311bb Mon Sep 17 00:00:00 2001 From: PhilRunninger Date: Mon, 1 Apr 2024 03:14:44 -0400 Subject: [PATCH] Add code to do ship_date shifting. Workbook changes not finished yet. --- Master Template.xlsm_EXPORTS/HttpHandler.bas | 4 +- .../JsonConverter.bas | 8 +- Master Template.xlsm_EXPORTS/Utils.bas | 48 ++ Master Template.xlsm_EXPORTS/build.frm | 6 +- Master Template.xlsm_EXPORTS/build.frx | Bin 3608 -> 3608 bytes Master Template.xlsm_EXPORTS/changes.frm | 4 +- Master Template.xlsm_EXPORTS/changes.frx | Bin 3096 -> 3096 bytes Master Template.xlsm_EXPORTS/fpvt.frm | 72 +-- Master Template.xlsm_EXPORTS/fpvt.frx | Bin 15896 -> 15896 bytes Master Template.xlsm_EXPORTS/handler.bas | 10 +- Master Template.xlsm_EXPORTS/openf.frm | 14 +- Master Template.xlsm_EXPORTS/openf.frx | Bin 3608 -> 3608 bytes Master Template.xlsm_EXPORTS/part.frx | Bin 3096 -> 3096 bytes Master Template.xlsm_EXPORTS/shConfig.cls | 2 +- Master Template.xlsm_EXPORTS/shMonthView.cls | 66 +-- Master Template.xlsm_EXPORTS/shOrders.cls | 47 -- Master Template.xlsm_EXPORTS/shShipments.cls | 144 ++++++ .../shipDateShifter.frm | 424 ++++++++++++++++ .../shipDateShifter.frx | Bin 0 -> 9752 bytes index.js | 16 + route_sql/shift_ship_date.sql | 477 ++++++++++++++++++ 21 files changed, 1202 insertions(+), 140 deletions(-) create mode 100644 Master Template.xlsm_EXPORTS/shShipments.cls create mode 100644 Master Template.xlsm_EXPORTS/shipDateShifter.frm create mode 100644 Master Template.xlsm_EXPORTS/shipDateShifter.frx create mode 100644 route_sql/shift_ship_date.sql diff --git a/Master Template.xlsm_EXPORTS/HttpHandler.bas b/Master Template.xlsm_EXPORTS/HttpHandler.bas index 75984b9..4e9c9bf 100644 --- a/Master Template.xlsm_EXPORTS/HttpHandler.bas +++ b/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 diff --git a/Master Template.xlsm_EXPORTS/JsonConverter.bas b/Master Template.xlsm_EXPORTS/JsonConverter.bas index f9dc6c1..1aa386e 100644 --- a/Master Template.xlsm_EXPORTS/JsonConverter.bas +++ b/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) diff --git a/Master Template.xlsm_EXPORTS/Utils.bas b/Master Template.xlsm_EXPORTS/Utils.bas index dbfeca9..f926b71 100644 --- a/Master Template.xlsm_EXPORTS/Utils.bas +++ b/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 + + + + diff --git a/Master Template.xlsm_EXPORTS/build.frm b/Master Template.xlsm_EXPORTS/build.frm index 0107139..de03b97 100644 --- a/Master Template.xlsm_EXPORTS/build.frm +++ b/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 diff --git a/Master Template.xlsm_EXPORTS/build.frx b/Master Template.xlsm_EXPORTS/build.frx index e8712a9d10d733c8dba71051d10b47fb40b65233..fe9b598a380c88803d9304103e4f06c370e3d8e6 100644 GIT binary patch delta 123 zcmbOsGec%W3k%zXCGYkzw`}fWabaOhoqV37n6YHCGpF(7ZJd0QTR4jaa~POJ7&I6d z7?>Cs8vMPBvnM-nDT$>5`4V7ZHlVO`VqS7;4g&*7iZOQbLKd^hGr3%V#@*x6W@MPm T#oYuXd$|o5lQ-| "" 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("QtyPctChange").Value = 0 - shMonthView.Range("PricePctChange").Value = 0 + shMonthView.Range("MonthComment").value = "" + shMonthView.Range("QtyPctChange").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 = "{}" - Set j = JsonConverter.ParseJson(tbAPI.text) - j("tag") = cbTAG.Value - tbAPI.text = JsonConverter.ConvertToJson(j) + 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() @@ -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 = "{}" - Set adjust = JsonConverter.ParseJson(tbAPI.text) + If tbapi.text = "" Then 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 - tbFcVal = (bVal + pVal) * (1 + tbpd.Value / 100) + 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) + 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) + 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.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 - sbpp.Value = 0 - sbpd.Value = 0 + sbpv.value = 0 + sbpp.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) - fPrc = co_num(tbFcPrice.Value, 0) + fVol = co_num(tbFcVol.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 diff --git a/Master Template.xlsm_EXPORTS/fpvt.frx b/Master Template.xlsm_EXPORTS/fpvt.frx index 0ee4d31aa3880bf3bb53affc0e96fc2c0cb76f3d..b854b0d30e69b6178dbca679963fd48700ef3fa1 100644 GIT binary patch delta 706 zcmZuv&ubGw6rMNJM7rvlNHA3so1{riH@`MNsOcIdZAz@AND*QYJS4=W2HGU1O0Wdm zgI;0|;=9Cys0Xp)B`_yJidR8OFM?DMJQW0?{sDrsn~OwY;Ct_T^S=4!@w%;UtJfNm zd(Zc`*@HdkBX18ihUGfzbDN5RT#_41?#Fx3M{L_00~D8zU$X#U$r(R!R69n<=AvG` zS*b32a<@v=Wqpm{mU9jm|K&VP2YOLDH7JMee<&`Uo(9ly!4(EC-gAw?7=Px90EH}m za=W2~KiuDq_)MP0)7&xo&hWG2p9T$Wfpt-T6qsS(7P7b-xWF2fvWeaKEFO${(S1IM zPsf{}ar@aN0D_fZftGdtA!vbNacNOB=n34J@LQ6E&@{ePPohn+GeQXZmCMW!GK3AR zD;Mbu;Ri~_P>O^n7^xAw9$u$4!as-K0HkmunrC&>L<-+WCAy|#F*=V|W9LkdMa_@B znAM;?>NwultRl6Tul=1H-|?tEOKFABtm&z!=Bco>rAAEoFY30DcH>jDMDT0Kcf=+f zcLYZsi(x|IHmm4Oem4;VNaL&I5;XC5vcSrE6AP)A5+Slo$ZHT9s^Z0mA;%MTLmYfT zLpU7NsM_9jRr96)x?raC87*5--?;;K6%# z4;*8U?IEC31#CDR5XJ9~ub^SWIYbFzovv3RP+aj2a4NGh%lA3uj6m)XTvbj98UAYf zTz5I?L;@dDKQ46N1;Q-H$ACNKd}&Gw?2S(ZQ!zI=%9j?y6~9-EYlJ57rFt060gEtF zUPNzTL?DFVQs6ZGQ-aHEJ&*zjV<_kszPt-KE-QQSXIL`Y zSXJV<95!*(A1*g7uN|?c(8~c)z`+g*3(BR!OthU_M3TbmH!}_hcZI+ra%gW%|s)>v7W`o z`2H)F7PPDz)A6U$)}|~I@|-iE8gN1$H|X_8!c}}iqiE~Rx6i+84pF7I2)hOgrNr=m zZJ4Xi0|waH&Zi9lCL*IQLwpM25-RxV3?{ QKH`pMI(UDxJ0DoUJO#lD@ diff --git a/Master Template.xlsm_EXPORTS/part.frx b/Master Template.xlsm_EXPORTS/part.frx index 3e6c7abe1fe00d31a27b93ee0e215d5c423e9533..60bb446e999974dd5c76d7f5ce5fae1cb4b6ce81 100644 GIT binary patch delta 79 zcmbOsF+*ZQ3k%zYjUV?hw`}fWVP;`sV3^#`Vb91g`8-FCAOi!F2!jR#kYZqH@b@mx hp6tV^#8^BzpR*gN;x}g`Bje;yE*(aO%}rd>7y*u!6(s-w delta 79 zcmV-V0I>g<7?>EagaiiQ*)hzhe6xxK0|WwPY?F@&KLK=;&j@T0Yybij04M+e00IC2 lfKN+EX_HI|A^`xCZwZS5Y?J#5Spi{_RSGNtbhCmAmI3fv7nuM6 diff --git a/Master Template.xlsm_EXPORTS/shConfig.cls b/Master Template.xlsm_EXPORTS/shConfig.cls index 5f89933..23b4d65 100644 --- a/Master Template.xlsm_EXPORTS/shConfig.cls +++ b/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 diff --git a/Master Template.xlsm_EXPORTS/shMonthView.cls b/Master Template.xlsm_EXPORTS/shMonthView.cls index 14cdd11..7a4e7a1 100644 --- a/Master Template.xlsm_EXPORTS/shMonthView.cls +++ b/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("MonthAdjustPrice").Value = Not shMonthView.Range("MonthAdjustVolume").Value + 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) @@ -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, 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) + 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 @@ -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, 6) = rev_cust(build.cbBill.Value) - .Cells(Target.row + i, 12) = rev_cust(build.cbShip.Value) + .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 @@ -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("tag") = shMonthView.Range("MonthTag").Value + adjust("message") = shMonthView.Range("MonthComment").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("tag") = shMonthView.Range("MonthTag").Value + adjust("message") = shMonthView.Range("MonthComment").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 diff --git a/Master Template.xlsm_EXPORTS/shOrders.cls b/Master Template.xlsm_EXPORTS/shOrders.cls index bf599ce..93962bc 100644 --- a/Master Template.xlsm_EXPORTS/shOrders.cls +++ b/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 - - diff --git a/Master Template.xlsm_EXPORTS/shShipments.cls b/Master Template.xlsm_EXPORTS/shShipments.cls new file mode 100644 index 0000000..4b7bae0 --- /dev/null +++ b/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 + + diff --git a/Master Template.xlsm_EXPORTS/shipDateShifter.frm b/Master Template.xlsm_EXPORTS/shipDateShifter.frm new file mode 100644 index 0000000..30091b1 --- /dev/null +++ b/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 + + + + + diff --git a/Master Template.xlsm_EXPORTS/shipDateShifter.frx b/Master Template.xlsm_EXPORTS/shipDateShifter.frx new file mode 100644 index 0000000000000000000000000000000000000000..7b7922894740b8a41ceabc01f9ddc1f57a10b76a GIT binary patch literal 9752 zcmeHNTWlOx89uw~Bu?t4xjN3J&E)Pljx)3C^(ARsJGOIiVmsIg;a2GEdXn9CcXqR$ z4G9RChd!4lq)LcFkq{DZ@IZN}cmeeRqykc(P?6w)ClJa*fu}Zn-pSR zp&t^sCgib2h$Jp}|Ivd754yV<4ZY z)$+;z9y<_@gqVg8WlQZy0l*X~E&+4EW#9@h4=ex- z?5n`1fF)oVxCUGYJ`LOeJ_CFf_#E(g;0wTuz!!lp0WSe2kOT6-3Sa^36Ssf@Py`qi zuK*>W46yAOw^iUaPy<#0K2P00GZtGpM3*MIdqfYP_gjGYnh@Xqx)6V0gES7-NDq6= zI|+Q~;_oIr_VoK2w)rLL}8|STD>wcg&Dt_o=urX)at=p*9Vm3x$W5&w2Zo`b*7=ew2%AMA2 zSoxSAS=d<2JFVMbj7Hl8K-mgQtLLXsz~k-n6O-S zgS{8sK|aG*(I43lId-tG27Scqqm?`DYcN8!T@HPC9KLl@&J&F{R=3+eozxpvCvC?; zC*|aw$5T!x&r>h8?;Gcj$I(8W)O9D%(`h+d>dPsIiS@H2KYO^ih1yNlpIR z_Sq)w@Hy6goc!qXuI+!je8ze^{&QYzhaa`Sc6&wrUz=~`+ViJf`%(Y@`}H67=YMaX z>#ug&mut_DlOL_0wc{b$A6w%emit!Z#oT49WaS-eMO)5WwplAyu!B3kIoMO|6K}zt zU~lBDx!z8O*IfN{7j_me7b=^f;X024TYFg3OoPwp@!@X8E?`hRqWu>0Cw7PBGt$Gh^ z*ULGpwyJ%(VA)!}RLs9ZTZ@+mwVahV>#LSlsjZNZH*LG(Xa)0*rJ2pb8f7^JQmyqK$Aeer=eM}?mEb4Q1eTsd3+55*G>7F8Jv^827xtSv7Lf$*v@S5JyZ=^MEb^Zx>Su}iexdaLD3D(I#r|BioHnHsO2ySSO+X;y`s^_O)+pi zuE9pDq1m8n#!NAR6q8yG10X1;Th)x3VreR_VW0(?jjCqE6gNlX8g`^Wvq{xtP4ShJ zaShW!f#xYyGi-|24#hQyg@&d_)nsbLONf584wxtn%6VGVq;2O#47Hx7U;G(aCp?Rb z+?31)Zblx`x$F4RtQ)^VPqX`6@VVQf+$`%|<+3}{?)E5mgzc(wnTaKLN0d9txKX*geD2ODcZ_kVa+%qs-QFm7 zoN=#mnE@tuSA=Wm>{lw6nPPJLqFjUhR^@V_BzJd|o94I>=Az%Z%si93$K!IOGSZHr zlk1IDUObS?p^MzTO|EW0!Prr`n1m#EUx=Fqm$9RA_xs#uL);9;KgN#A)qL)AA?~oF zk1}>t?g5{>Kg7)!4nj&@`0sN7>d_eh9~sinZ!@wna`hNf}3O5&KJ14q3v z`G7S2cqn z&48-W$7S8B8iYsVc}~PMV{$%HHCS*oG=nkCsEiF&b1I}c8Pkl&`AF5UU4ptEifOVA zV_Vf2A)a@MsPk-HJOmch-uP-^O2_+li z+s;lbn*3~tpNa5wgK?(v`Nk`-KOEs3a_m(3=?=bOL4{^=-R&ao>0Y>0m*%9r!E%AW}F zpO5l0j3Jf(LWqAh%1<+XJbu57A2hd%Ay@i;5$6f;ub4TjG?LEq?bLhtj_*qOP7YI) zJB>TGFJo>BtB-tnW%05p#IJ3Cx8TPa=Q^%mS(j|za~{{*IAYu+pRpFiCDx+uEbiDh z-v_2Wzi*f|8=E^l{TCD{cO$+p^!q$`tasM`OvCSt_#Ix627YtRM%x#_q0h74`0a1j zj5N86Dg1!E9=Y6gox|N#U=k~ZQf_%>_L{e={zq4oHz_%M+bek&XO{8~>&)|$+yvg5 zrcgZJm8$={z?I8'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