81174b5d57
1. Remove/Hide Swap Part 2. Remove/Hide Swap Customer 3. Improved the location of controls on fpvt form. 4. Make user experience more intuitive on the Month sheet 5. Make more and better use of named ranges in place of hardcoded cell locations. 6. Added error checking to ensure Tag is entered and at least one month has a forecast on Month sheet.
1042 lines
30 KiB
OpenEdge ABL
1042 lines
30 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 dumping 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 basket_touch As Range
|
|
Private showbasket As Boolean
|
|
Private np As Object 'json dedicated to new part scenario
|
|
Private b() As Variant 'holds basket
|
|
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
|
|
|
|
dumping = 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
|
|
|
|
dumping = 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
|
|
|
|
dumping = 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
|
|
|
|
dumping = False
|
|
|
|
Call Me.mvp_adj
|
|
|
|
Application.ScreenUpdating = True
|
|
End Sub
|
|
|
|
|
|
Private Sub Worksheet_Change(ByVal Target As Range)
|
|
'---this needs checked prior to dumping 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 dumping Then Exit Sub
|
|
|
|
If Not Intersect(Target, Range("A1:R18")) Is Nothing Then
|
|
If Target.Columns.Count > 1 Then
|
|
MsgBox ("you can only change one column at a time - your change will be undone")
|
|
dumping = True
|
|
Application.Undo
|
|
dumping = False
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
If Not Intersect(Target, Range("QtyNewAdj")) Is Nothing Then Call Me.mvp_adj
|
|
If Not Intersect(Target, Range("QtyFinal")) Is Nothing Then Call Me.mvp_set
|
|
If Not Intersect(Target, Range("PriceNewAdj")) Is Nothing Then Call Me.mvp_adj
|
|
If Not Intersect(Target, Range("PriceFinal")) Is Nothing Then Call Me.mvp_set
|
|
If Not Intersect(Target, Range("SalesNewAdj")) Is Nothing Then Call Me.ms_adj
|
|
If Not Intersect(Target, Range("SalesFinal")) Is Nothing Then Call Me.ms_set
|
|
|
|
If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
|
|
Set basket_touch = Target
|
|
Call Me.get_edit_basket
|
|
Set basket_touch = Nothing
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
|
If Not Intersect(Target, Range("basket")) Is Nothing 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 Not Intersect(Selection, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
|
|
Call Me.basket_pick(Selection)
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
|
|
|
|
If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
|
|
Cancel = True
|
|
Call Me.basket_pick(Target)
|
|
Target.Select
|
|
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
|
|
Call Me.get_sheet
|
|
|
|
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
|
|
|
|
Me.crunch_array
|
|
Me.build_json
|
|
Me.set_sheet
|
|
|
|
|
|
End Sub
|
|
|
|
Sub mvp_adj()
|
|
|
|
Dim i As Integer
|
|
Call Me.get_sheet
|
|
|
|
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
|
|
|
|
Me.crunch_array
|
|
Me.build_json
|
|
Me.set_sheet
|
|
|
|
|
|
End Sub
|
|
|
|
Sub ms_set()
|
|
|
|
On Error GoTo errh
|
|
|
|
Dim i As Integer
|
|
Call Me.get_sheet
|
|
Dim vp As String
|
|
vp = shMonthView.Range("MonthVariable")
|
|
|
|
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))
|
|
Select Case vp
|
|
Case "volume"
|
|
If co_num(price(i, 5), 0) = 0 Then
|
|
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
|
|
dumping = True
|
|
Application.Undo
|
|
dumping = False
|
|
Exit Sub
|
|
End If
|
|
'reset price to original - delete these lines if a cascading effect is desired
|
|
'price(i, 4) = 0
|
|
'price(i, 5) = price(i, 2) + price(i, 3)
|
|
'calc volume change on original price
|
|
units(i, 5) = sales(i, 5) / price(i, 5)
|
|
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
|
Case "price"
|
|
If co_num(units(i, 5), 0) = 0 Then
|
|
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
|
|
dumping = True
|
|
Application.Undo
|
|
dumping = 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))
|
|
Case Else
|
|
MsgBox ("error forcing sales with no offset specified - your change will be undone")
|
|
dumping = True
|
|
Application.Undo
|
|
dumping = False
|
|
Exit Sub
|
|
End Select
|
|
End If
|
|
Next i
|
|
|
|
Me.crunch_array
|
|
Me.build_json
|
|
Me.set_sheet
|
|
|
|
errh:
|
|
If Err.Number <> 0 Then rollback = True
|
|
|
|
|
|
End Sub
|
|
|
|
Sub ms_adj()
|
|
|
|
Dim i As Integer
|
|
Call Me.get_sheet
|
|
Dim vp As String
|
|
vp = shMonthView.Range("MonthVariable")
|
|
|
|
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)
|
|
Select Case vp
|
|
Case "volume"
|
|
If co_num(price(i, 5), 0) = 0 Then
|
|
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
|
|
dumping = True
|
|
Application.Undo
|
|
dumping = False
|
|
Exit Sub
|
|
End If
|
|
'reset price to original
|
|
'price(i, 4) = 0
|
|
'price(i, 5) = price(i, 2) + price(i, 3)
|
|
'calc volume change on original price
|
|
units(i, 5) = sales(i, 5) / price(i, 5)
|
|
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
|
Case "price"
|
|
If co_num(units(i, 5), 0) = 0 Then
|
|
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
|
|
dumping = True
|
|
Application.Undo
|
|
dumping = 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))
|
|
Case Else
|
|
MsgBox ("error forcing sales with no offset specified - your change will be undone")
|
|
dumping = True
|
|
Application.Undo
|
|
dumping = False
|
|
Exit Sub
|
|
End Select
|
|
End If
|
|
Next i
|
|
|
|
Me.crunch_array
|
|
Me.build_json
|
|
Me.set_sheet
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Sub get_sheet()
|
|
|
|
Dim i As Integer
|
|
|
|
units = Range("units")
|
|
price = Range("price")
|
|
sales = Range("sales")
|
|
tunits = Range("tunits")
|
|
tprice = Range("tprice")
|
|
tsales = Range("tsales")
|
|
ReDim adjust(12)
|
|
|
|
End Sub
|
|
|
|
Private Function basejson() As Object
|
|
Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
|
|
End Function
|
|
|
|
Sub set_sheet()
|
|
|
|
Dim i As Integer
|
|
|
|
dumping = True
|
|
|
|
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")), shMonthView.Name, 6, 20, False, False, False)
|
|
'shMonthView.Range("B32:Q5000").ClearContents
|
|
|
|
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
|
|
|
|
dumping = False
|
|
|
|
End Sub
|
|
|
|
Sub load_sheet()
|
|
|
|
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 = Range("tunits")
|
|
tprice = Range("tprice")
|
|
tsales = 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)
|
|
Call Me.crunch_array
|
|
Call Me.set_sheet
|
|
Call Me.print_basket
|
|
Call Me.set_format
|
|
did_load_config = False
|
|
|
|
End Sub
|
|
|
|
Sub set_format()
|
|
|
|
Dim prices As Range
|
|
Dim price_adj As Range
|
|
Dim price_set As Range
|
|
Dim vol As Range
|
|
Dim vol_adj As Range
|
|
Dim vol_set As Range
|
|
Dim val As Range
|
|
Dim val_adj As Range
|
|
Dim val_set As Range
|
|
|
|
Set prices = shMonthView.Range("price")
|
|
Set price_adj = shMonthView.Range("PriceNewAdj")
|
|
Set price_set = shMonthView.Range("PriceFinal")
|
|
|
|
Set vol = shMonthView.Range("units")
|
|
Set vol_adj = shMonthView.Range("QtyNewAdj")
|
|
Set vol_set = shMonthView.Range("QtyFinal")
|
|
|
|
Set val = shMonthView.Range("sales")
|
|
Set val_adj = shMonthView.Range("SalesNewAdj")
|
|
Set val_set = shMonthView.Range("SalesFinal")
|
|
|
|
Call Me.format_price(prices)
|
|
Call Me.set_border(prices)
|
|
Call Me.fill_yellow(price_adj)
|
|
Call Me.fill_none(price_set)
|
|
|
|
Call Me.format_number(vol)
|
|
Call Me.set_border(vol)
|
|
Call Me.fill_yellow(vol_adj)
|
|
Call Me.fill_none(vol_set)
|
|
|
|
Call Me.format_number(val)
|
|
Call Me.set_border(val)
|
|
Call Me.fill_yellow(val_adj)
|
|
Call Me.fill_none(val_set)
|
|
|
|
End Sub
|
|
|
|
Sub set_border(ByRef targ As Range)
|
|
|
|
targ.Borders(xlDiagonalDown).LineStyle = xlNone
|
|
targ.Borders(xlDiagonalUp).LineStyle = xlNone
|
|
With targ.Borders(xlEdgeLeft)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlEdgeTop)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlEdgeBottom)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlEdgeRight)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlInsideVertical)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlInsideHorizontal)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Sub fill_yellow(ByRef Target As Range)
|
|
|
|
With Target.Interior
|
|
.Pattern = xlSolid
|
|
.PatternColorIndex = xlAutomatic
|
|
.ThemeColor = xlThemeColorAccent4
|
|
.TintAndShade = 0.799981688894314
|
|
.PatternTintAndShade = 0
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Sub fill_grey(ByRef Target As Range)
|
|
|
|
|
|
With Target.Interior
|
|
.Pattern = xlSolid
|
|
.PatternColorIndex = xlAutomatic
|
|
.ThemeColor = xlThemeColorDark1
|
|
.TintAndShade = -0.149998474074526
|
|
.PatternTintAndShade = 0
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Sub fill_none(ByRef Target As Range)
|
|
|
|
With Target.Interior
|
|
.Pattern = xlNone
|
|
.TintAndShade = 0
|
|
.PatternTintAndShade = 0
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Sub format_price(ByRef Target As Range)
|
|
|
|
Target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
|
|
|
End Sub
|
|
|
|
Sub format_number(ByRef Target As Range)
|
|
|
|
Target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
|
|
|
End Sub
|
|
|
|
Sub build_json()
|
|
|
|
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("MonthTags").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.Cells(5 + 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.Cells(5 + 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.Cells(5 + 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("B33").value
|
|
'np("basket") = x.json_from_table(b, "basket", False)
|
|
'get the basket from the sheet
|
|
b = shMonthUpdate.Range("U1").CurrentRegion.value
|
|
Set m = JsonConverter.ParseJson(Utils.json_from_table(b, "basket", False))
|
|
If UBound(b, 1) <= 2 Then
|
|
Set np("basket") = JsonConverter.ParseJson("[" & Utils.json_from_table(b, "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
|
|
|
|
Sub crunch_array()
|
|
|
|
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()
|
|
|
|
Call Me.load_sheet
|
|
|
|
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
|
|
dumping = True
|
|
shMonthView.Range("basket").ClearContents
|
|
' Rows("20:31").Hidden = False
|
|
dumping = False
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long
|
|
Dim basket() As Variant
|
|
basket = Utils.SHTp_get_block(shMonthUpdate.Range("U1"))
|
|
|
|
dumping = True
|
|
|
|
shMonthView.Range("basket").ClearContents
|
|
For i = 1 To UBound(basket, 1)
|
|
shMonthView.Cells(31 + i, 2) = basket(i, 1)
|
|
shMonthView.Cells(31 + i, 6) = basket(i, 2)
|
|
shMonthView.Cells(31 + i, 12) = basket(i, 3)
|
|
shMonthView.Cells(31 + i, 17) = basket(i, 4)
|
|
Next i
|
|
|
|
Rows("21:31").Hidden = True
|
|
|
|
dumping = False
|
|
|
|
End Sub
|
|
|
|
|
|
Sub basket_pick(ByRef Target As Range)
|
|
|
|
Dim i As Long
|
|
|
|
|
|
build.part = shMonthView.Cells(Target.row, 2)
|
|
build.bill = rev_cust(shMonthView.Cells(Target.row, 6))
|
|
build.ship = rev_cust(shMonthView.Cells(Target.row, 12))
|
|
build.useval = False
|
|
build.Show
|
|
|
|
If build.useval Then
|
|
dumping = True
|
|
'if an empty row is selected, force it to be the next open slot
|
|
If shMonthView.Cells(Target.row, 2) = "" Then
|
|
Do Until shMonthView.Cells(Target.row + i, 2) <> ""
|
|
i = i - 1
|
|
Loop
|
|
i = i + 1
|
|
End If
|
|
|
|
|
|
shMonthView.Cells(Target.row + i, 2) = build.cbPart.value
|
|
shMonthView.Cells(Target.row + i, 6) = rev_cust(build.cbBill.value)
|
|
shMonthView.Cells(Target.row + i, 12) = rev_cust(build.cbShip.value)
|
|
dumping = False
|
|
Set basket_touch = Selection
|
|
Call Me.get_edit_basket
|
|
Set basket_touch = Nothing
|
|
|
|
End If
|
|
Target.Select
|
|
|
|
|
|
End Sub
|
|
|
|
Sub get_edit_basket()
|
|
|
|
Dim i As Long
|
|
Dim mix As Double
|
|
Dim touch_mix As Double
|
|
Dim untouched As Long
|
|
Dim touch() As Boolean
|
|
|
|
'ReDim b(basket_rows, 3)
|
|
|
|
i = 0
|
|
Do Until shMonthView.Cells(33 + i, 2) = ""
|
|
i = i + 1
|
|
Loop
|
|
i = i - 1
|
|
|
|
ReDim b(i, 3)
|
|
ReDim touch(i)
|
|
untouched = i + 1
|
|
|
|
i = 0
|
|
mix = 0
|
|
Do Until shMonthView.Cells(33 + i, 2) = ""
|
|
b(i, 0) = shMonthView.Cells(33 + i, 2)
|
|
b(i, 1) = shMonthView.Cells(33 + i, 6)
|
|
b(i, 2) = shMonthView.Cells(33 + i, 12)
|
|
b(i, 3) = shMonthView.Cells(33 + i, 17)
|
|
If b(i, 3) = "" Then b(i, 3) = 0
|
|
mix = mix + b(i, 3)
|
|
If Not Intersect(basket_touch, shMonthView.Cells(33 + i, 17)) Is Nothing Then
|
|
touch_mix = touch_mix + b(i, 3)
|
|
touch(i) = True
|
|
untouched = untouched - 1
|
|
End If
|
|
i = i + 1
|
|
Loop
|
|
|
|
'evaluate mix changes and force to 100
|
|
For i = 0 To UBound(b, 1)
|
|
If Not touch(i) Then
|
|
If mix - touch_mix = 0 Then
|
|
b(i, 3) = (1 - mix) / untouched
|
|
Else
|
|
b(i, 3) = b(i, 3) + b(i, 3) * (1 - mix) / (mix - touch_mix)
|
|
End If
|
|
End If
|
|
Next i
|
|
|
|
dumping = True
|
|
|
|
'put the mix plug back on the the sheet
|
|
For i = 0 To UBound(b, 1)
|
|
shMonthView.Cells(33 + i, 17) = b(i, 3)
|
|
Next i
|
|
|
|
dumping = False
|
|
|
|
shMonthUpdate.Range("U2:X5000").ClearContents
|
|
Call Utils.SHTp_DumpVar(b, shMonthUpdate.Name, 2, 21, False, False, True)
|
|
|
|
If Me.newpart Then
|
|
Me.build_json
|
|
End If
|
|
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Sub post_adjust()
|
|
Dim i As Long
|
|
Dim msg As String
|
|
If Not Me.newpart Then
|
|
msg = "Make sure at least one month has Final values for Volume, Price, and Sales."
|
|
For i = 2 To 13
|
|
If shMonthUpdate.Cells(i, 16) <> "" Then msg = ""
|
|
Next i
|
|
End If
|
|
If IsEmpty(shMonthView.Range("MonthTags").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("MonthTags").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("MonthTags").value
|
|
jdoc = JsonConverter.ConvertToJson(adjust)
|
|
Call handler.request_adjust(jdoc, fail)
|
|
If fail Then Exit Sub
|
|
End If
|
|
Next i
|
|
End If
|
|
|
|
shOrders.Select
|
|
'shMonthView.Visible = xlHidden
|
|
|
|
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
|
|
|
|
dumping = 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
|
|
Call Me.load_sheet
|
|
|
|
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
|
|
|
|
dumping = 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
|
|
|
|
dumping = True
|
|
|
|
shMonthView.Range("basket").ClearContents
|
|
|
|
For i = 1 To UBound(cust, 2)
|
|
shMonthView.Cells(32 + i, 2) = part.cbPart.value
|
|
shMonthView.Cells(32 + i, 6) = cust(0, i)
|
|
shMonthView.Cells(32 + i, 12) = cust(1, i)
|
|
shMonthView.Cells(32 + i, 17) = CDbl(cust(2, i))
|
|
Next i
|
|
|
|
shConfig.Range("new_part").value = 1
|
|
|
|
'------copy revised basket to _month storage---------------------------------------------------
|
|
|
|
i = 0
|
|
Do Until shMonthView.Cells(33 + i, 2) = ""
|
|
i = i + 1
|
|
Loop
|
|
i = i - 1
|
|
If i = -1 Then i = 0
|
|
ReDim b(i, 3)
|
|
i = 0
|
|
Do Until shMonthView.Cells(33 + i, 2) = ""
|
|
b(i, 0) = shMonthView.Cells(33 + i, 2)
|
|
b(i, 1) = shMonthView.Cells(33 + i, 6)
|
|
b(i, 2) = shMonthView.Cells(33 + i, 12)
|
|
b(i, 3) = shMonthView.Cells(33 + i, 17)
|
|
If b(i, 3) = "" Then b(i, 3) = 0
|
|
i = i + 1
|
|
Loop
|
|
shMonthUpdate.Range("U2:AC10000").ClearContents
|
|
Call Utils.SHTp_DumpVar(b, shMonthUpdate.Name, 2, 21, False, False, True)
|
|
Call Utils.SHTp_DumpVar(b, 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 = Range("B18:F18")
|
|
tprice = Range("H18:L18")
|
|
tsales = Range("N18:R18")
|
|
ReDim adjust(12)
|
|
For i = 1 To 12
|
|
'volume
|
|
units(i, 5) = units(i, 2)
|
|
units(i, 4) = units(i, 2)
|
|
units(i, 1) = 0
|
|
units(i, 2) = 0
|
|
units(i, 3) = 0
|
|
'sales
|
|
sales(i, 5) = sales(i, 2)
|
|
sales(i, 4) = sales(i, 2)
|
|
sales(i, 1) = 0
|
|
sales(i, 2) = 0
|
|
sales(i, 3) = 0
|
|
'price
|
|
price(i, 5) = price(i, 2)
|
|
price(i, 4) = price(i, 2)
|
|
price(i, 1) = 0
|
|
price(i, 2) = 0
|
|
price(i, 3) = 0
|
|
Next i
|
|
Call Me.crunch_array
|
|
Call Me.build_json
|
|
Call Me.set_sheet
|
|
|
|
'-------------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
|
|
dumping = False
|
|
|
|
End Sub
|
|
|
|
Function newpart() As Boolean
|
|
newpart = shConfig.Range("new_part").value = 1
|
|
End Function
|