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 dumping As Boolean
Private vedit As String
Private adjust() As Object
Private jtext() As Variant
Private basejson As Object
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


Private Sub sbMPP_Change()
    Dim m As Worksheet
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    dumping = True
    
    Set m = shMonthView
    m.Cells(19, 11) = sbMPP.value / 100
    For i = 6 To 17
        m.Cells(i, 11) = (m.Cells(i, 9)) * m.Cells(19, 11)
    Next i
    
    Me.mvp_adj
    
    dumping = False
    
    Application.ScreenUpdating = True
End Sub


Private Sub sbMPV_Change()
    Dim m As Worksheet
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    dumping = True
    
    Set m = shMonthView
    m.Cells(19, 5) = sbMPV.value / 100
    For i = 6 To 17
        If m.Cells(i, 5) <> "" Then
            m.Cells(i, 5) = (m.Cells(i, 3)) * m.Cells(19, 5)
        End If
    Next i
    
    dumping = False
    
    Call Me.mvp_adj
    
    
    Application.ScreenUpdating = True
End Sub



Private Sub tbMCOM_Change()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    '---this needs checked prior to dumping check becuase % increase spinners are flagged as dumps
    If Not did_load_config Then
        Call handler.load_config
        did_load_config = True
    End If

    If Not dumping Then
    
        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("E6:E17")) Is Nothing Then Call Me.mvp_adj
        If Not Intersect(Target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
        If Not Intersect(Target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
        If Not Intersect(Target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
        If Not Intersect(Target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
        If Not Intersect(Target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
        
        If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
            Set basket_touch = Target
            Call Me.get_edit_basket
            Set basket_touch = Nothing
        End If
        
    End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


    If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
        Cancel = True
        Call Me.basket_pick(Target)
        Target.Select
    End If

End Sub


Sub picker_shortcut()
    
    If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 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("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 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("Q2")

    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("Q2")

    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("B6:F17")
    price = Range("H6:L17")
    sales = Range("N6:R17")
    tunits = Range("B18:F18")
    tprice = Range("H18:L18")
    tsales = Range("N18:R18")
    ReDim adjust(12)
    Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
      
End Sub

Sub set_sheet()

    Dim i As Integer

    dumping = True
    
    Range("B6:F17") = units
    Range("H6:L17") = price
    Range("N6:R17") = sales
    Range("B18:F18").FormulaR1C1 = tunits
    Range("H18:L18").FormulaR1C1 = tprice
    Range("N18:R18").FormulaR1C1 = tsales
    Range("T6:U18").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("B18:F18")
    tprice = Range("H18:L18")
    tsales = Range("N18:R18")
    '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("H6:L17")
    Set price_adj = shMonthView.Range("K6:K17")
    Set price_set = shMonthView.Range("L6:L17")
    
    Set vol = shMonthView.Range("B6:F17")
    Set vol_adj = shMonthView.Range("E6:E17")
    Set vol_set = shMonthView.Range("F6:F17")
    
    Set val = shMonthView.Range("N6:R17")
    Set val_adj = shMonthView.Range("Q6:Q17")
    Set val_set = shMonthView.Range("R6:R17")
    
    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

    ReDim handler.basis(100)
    i = 2
    j = 0
    Do While shConfig.Cells(2, i) <> ""
        handler.basis(j) = shConfig.Cells(2, i)
        j = j + 1
        i = i + 1
    Loop
    ReDim Preserve handler.basis(j - 1)
    
    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") = cbMTAG.text
        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()


    If shConfig.Cells(6, 2) = 1 Then
        shConfig.Cells(6, 2) = 0
    Else
        shConfig.Cells(6, 2) = 1
    End If
    
    Call Me.print_basket
    

End Sub

Sub print_basket()

    'SHCONFIG.Cells(6, 2) = 1
    If shConfig.Cells(6, 2) = 0 Then
        dumping = True
        shMonthView.Range("B32:Q10000").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("B32:Q10000").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 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") = Me.tbMCOM.text
        adjust("tag") = Me.cbMTAG.text
        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") = Me.tbMCOM.text
                adjust("tag") = Me.cbMTAG.text
                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.Cells(5, 2) = 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("B33:Q10000").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.Cells(7, 2) = 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)
    Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
    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.Cells(6, 2) = 1
    Call Me.print_basket
    dumping = False
    
End Sub

Function newpart() As Boolean

    If shConfig.Cells(7, 2) = 1 Then
        newpart = True
    Else
        newpart = False
    End If
    
End Function