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