forecast_api/VBA/shMonthView.cls

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