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