fde6c97964
A lot has changed here, including:
1. Adding pounds to the data available for display in pivot table.
2. Visual improvements
3. Code simplification
4. Hiding / showing sheets as needed. A developer's backdoor allows for
easy toggling for debugging purposes: Ctrl+RightClick on the Forecast
Adjustment form's "Selected Scenario" label.
5. Fixed a bug that happened when deleting rows from the basket. The
definition of the Target variable was lost in some cases.
6. Made use of the Cancel and Default form properties to purge some
unnecessary code.
7. Added a sheet that contains Help text for the users.
8. Replacing more harcoded range reference with range names.
9. Refactor checks for division by zero errors, and improve error
messages for users.
10. Remove manual formatting. It's already done and saved in the
workbook; there's no need to redo it in code.
11. Added more data validation before Save operation proceeds.
12. Added a new IntersectsWith function to simplify If statements.
905 lines
27 KiB
OpenEdge ABL
905 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
|
|
|
|
|
|
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
|
|
|
|
|
|
|