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