add a new route for swapping out parts

TheBigOne.cls

@@ -459,6 +459,43 @@ Sub ARRAYp_Transpose(ByRef a() As String)
 
 End Sub
 
+Function ARRAYp_TransposeVar(ByRef a() As Variant) As Variant()
+
+    Dim s() As Variant
+    ReDim s(UBound(a, 2), UBound(a, 1))
+    
+    Dim i As Long
+    Dim j As Long
+    
+    For i = 0 To UBound(s, 1)
+        For j = 0 To UBound(s, 2)
+            s(i, j) = a(j, i)
+        Next j
+    Next i
+
+    ARRAYp_TransposeVar = s
+
+End Function
+
+Function ARRAYp_zerobased_addheader(ByRef z() As Variant, ParamArray cols()) As Variant()
+
+    Dim i As Long
+    Dim j As Long
+
+    Dim r() As Variant
+    ReDim r(UBound(z, 1), UBound(z, 2) + 1)
+    
+    For i = 0 To UBound(r, 1)
+        For j = 1 To UBound(r, 2)
+            r(i, j) = z(i, j - 1)
+        Next j
+        r(i, 0) = cols(i)
+    Next i
+    
+    ARRAYp_zerobased_addheader = r
+    
+End Function
+
 
 Public Function SHTp_Get(ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef headers As Boolean) As String()
 
@@ -1461,11 +1498,11 @@ End Function
 Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITLE As String = "") As Boolean
     
     Application.EnableCancelKey = xlDisabled
-    MsgB.tbMSG.Text = Message
+    MsgB.tbMSG.text = Message
     MsgB.Caption = TITLE
     MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
     MsgB.Show
-    MISC_msgbox_cancel = MsgB.cancel
+    MISC_msgbox_cancel = MsgB.Cancel
     Application.EnableCancelKey = xlInterrupt
 
 End Function
@@ -2037,7 +2074,7 @@ Function json_concat(list As Range) As String
 
 End Function
 
-Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
+Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
 
     
     Dim i As Long
@@ -2045,7 +2082,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, tri
     Dim sql As String
     Dim rec As String
     
-    sql = "INSERT INTO " & target & " VALUES " & vbCrLf
+    sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
     For i = start To ending
         rec = ""
         If i <> start Then sql = sql & "," & vbCrLf
@@ -2151,6 +2188,70 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
 
 End Function
 
+Public Function json_from_table_zb(ByRef tbl() As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
+
+
+    Dim ajson As String
+    Dim json As String
+    Dim r As Integer
+    Dim c As Integer
+    Dim needs_comma As Boolean
+    Dim needs_braces As Integer
+    
+    needs_comma = False
+    needs_braces = 0
+    ajson = ""
+    
+    For r = 1 To UBound(tbl, 1)
+        For c = 0 To UBound(tbl, 2)
+            If tbl(r, c) <> "" Then
+                needs_braces = needs_braces + 1
+                If needs_comma Then json = json & ","
+                needs_comma = True
+                If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
+                    json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & tbl(r, c)
+                Else
+                    'test if item is a json object
+                    If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
+                        json = json & """" & tbl(0, c) & """" & ":" & tbl(r, c)
+                    Else
+                        json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
+                    End If
+                End If
+            End If
+        Next c
+        If needs_braces > 0 Then json = "{" & json & "}"
+        needs_comma = False
+        needs_braces = 0
+        If r > 1 Then
+            ajson = ajson & "," & json
+        Else
+            ajson = json
+        End If
+        json = ""
+    Next r
+    
+    'if theres more the one record, include brackets for array
+    'if an array_label is given give the array a key and the array become the value
+    'then if the array is labeled with a key it should have braces unless specified otherwise
+    If r > 2 Then
+        ajson = "[" & ajson & "]"
+        If array_label <> "" Then
+            ajson = """" & array_label & """:" & ajson
+            If Not strip_braces Then
+                ajson = "{" & ajson & "}"
+            End If
+        End If
+    Else
+        If strip_braces Then
+            ajson = Mid(ajson, 2, Len(ajson) - 2)
+        End If
+    End If
+      
+    json_from_table_zb = ajson
+
+End Function
+
 Public Function MISCe_MaxLng(ByRef base As Long, ByRef compare As Long) As Long
 
     If compare < base Then
@@ -2444,7 +2545,7 @@ Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As Strin
     Dim s As String, tmp As Double, i As Integer, lastI As Integer
     Dim BaseSize As Integer
     BaseSize = Len(sNewBaseDigits)
-    Do While Val(d) <> 0
+    Do While val(d) <> 0
         tmp = d
         i = 0
         Do While tmp >= BaseSize
@@ -2598,3 +2699,32 @@ Function TBLp_VarToString(ByRef t() As Variant) As String()
     TBLp_VarToString = x
 
 End Function
+
+Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox, ParamArray cols())
+
+    Dim i As Long
+
+    hdr.ColumnCount = det.ColumnCount
+    hdr.ColumnWidths = det.ColumnWidths
+
+    ' add header elements
+    hdr.clear
+    hdr.AddItem
+    For i = 0 To UBound(cols, 1)
+        hdr.list(0, i) = cols(i)
+    Next i
+    
+    ' make it pretty
+    'body.ZOrder (1)
+    'lbHEAD.ZOrder (0)
+    hdr.SpecialEffect = fmSpecialEffectFlat
+    'hdr.BackColor = RGB(200, 200, 200)
+    hdr.Height = 10
+
+    ' align header to body (should be done last!)
+    hdr.width = det.width
+    hdr.Left = det.Left
+    hdr.Top = det.Top - (hdr.Height - 1)
+    
+End Sub
+

changes.frm

@@ -13,7 +13,7 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
-Private X As Variant
+Private x As Variant
 
 Private Sub cbCancel_Click()
 
@@ -34,7 +34,7 @@ Private Sub lbHist_Change()
 
     For i = 0 To Me.lbHist.ListCount - 1
         If Me.lbHist.Selected(i) Then
-            Me.tbPrint.value = X(i, 7)
+            Me.tbPrint.value = x(i, 7)
             Exit Sub
         End If
     Next i
@@ -68,12 +68,37 @@ Private Sub UserForm_Activate()
     Dim fail As Boolean
     
     'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
-    X = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
+    x = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
     If fail Then
         Me.Hide
         Exit Sub
     End If
-    Me.lbHist.list = X
+    Me.lbHist.list = x
+    
+    lbHEAD.ColumnCount = lbHist.ColumnCount
+    lbHEAD.ColumnWidths = lbHist.ColumnWidths
+
+    ' add header elements
+    lbHEAD.clear
+    lbHEAD.AddItem
+    lbHEAD.list(0, 0) = "Modifier"
+    lbHEAD.list(0, 1) = "Owner"
+    lbHEAD.list(0, 2) = "When"
+    lbHEAD.list(0, 3) = "Tag"
+    lbHEAD.list(0, 4) = "Comment"
+    lbHEAD.list(0, 5) = "Sales"
+    
+    ' make it pretty
+    'body.ZOrder (1)
+    'lbHEAD.ZOrder (0)
+    'lbHEAD.SpecialEffect = fmSpecialEffectFlat
+    'lbHEAD.BackColor = RGB(200, 200, 200)
+    lbHEAD.Height = 10
+
+    ' align header to body (should be done last!)
+    lbHEAD.width = lbHist.width
+    lbHEAD.Left = lbHist.Left
+    lbHEAD.Top = lbHist.Top - (lbHEAD.Height - 1)
 
 End Sub
 
@@ -91,7 +116,7 @@ Sub delete_selected()
     
     For i = 0 To Me.lbHist.ListCount - 1
         If Me.lbHist.Selected(i) Then
-            Call handler.undo_changes(X(i, 6), fail)
+            Call handler.undo_changes(x(i, 6), fail)
             If fail Then
                 MsgBox ("undo did not work")
                 Exit Sub

fpvt.frm

@@ -4,7 +4,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
    ClientHeight    =   8445.001
    ClientLeft      =   120
    ClientTop       =   465
-   ClientWidth     =   8820.001
+   ClientWidth     =   9285.001
    OleObjectBlob   =   "fpvt.frx":0000
    StartUpPosition =   1  'CenterOwner
 End
@@ -24,6 +24,11 @@ Private load_tb As Boolean
 Private set_Price As Boolean
 Private sp As Object
 Private basket() As Variant
+Private vSwap() As Variant
+Private swapline As Integer
+Private set_swapalt As Boolean
+Private return_swap As Boolean
+Private jswap As Object
 
 Private bVol As Double
 Private bVal As Double
@@ -66,8 +71,9 @@ End Sub
 Private Sub butAdjust_Click()
     
     Dim fail As Boolean
+    Dim doc As String
     
-    If adjust("source") = "" Then
+    If tbAPI.text = "" Then
         MsgBox ("No adjustments provided")
         Exit Sub
     End If
@@ -77,7 +83,25 @@ Private Sub butAdjust_Click()
         Exit Sub
     End If
     
-    Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
+    Select Case fpvt.mp.SelectedItem.Name
+        Case "pageSWAP"
+            doc = tbAPI.text
+            If doc = "" Then
+                MsgBox ("no part swap setup")
+                Exit Sub
+            End If
+        Case "pAnn"
+            doc = tbAPI.text
+            If doc = "" Then
+                MsgBox ("no adjustements are ready")
+                Exit Sub
+            End If
+        Case Else
+            MsgBox ("not on an adjustable tab")
+            Exit Sub
+    End Select
+    
+    Call handler.request_adjust(doc, fail)
     If fail Then
         MsgBox ("adjustment was not made due to error")
         Exit Sub
@@ -126,24 +150,24 @@ Private Sub cbGoSheet_Click()
     Worksheets("month").sbMPP.value = 0
     
     Me.Hide
+    months.cbMTAG.value = ""
     Worksheets("month").Visible = xlSheetVisible
     Sheets("month").Select
 
 End Sub
 
+
 Private Sub cbTAG_Change()
-    
         
+    Dim j As Object
     If tbAPI.text = "" Then tbAPI.text = "{}"
-    Set adjust = JsonConverter.ParseJson(tbAPI.text)
-    adjust("tag") = cbTAG.value
-    tbAPI.text = JsonConverter.ConvertToJson(adjust)
+    Set j = JsonConverter.ParseJson(tbAPI.text)
+    j("tag") = cbTAG.value
+    tbAPI.text = JsonConverter.ConvertToJson(j)
     
 End Sub
 
-Private Sub Label64_Click()
 
-End Sub
 
 Private Sub lbMonth_Change()
 
@@ -180,10 +204,132 @@ Private Sub lbMonth_Change()
     
 End Sub
 
-Private Sub lheader_Click()
+Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+    
+    If KeyCode <> 13 Then Exit Sub
+    Dim i As Long
+    If set_swapalt Then Exit Sub
+    Dim vtable() As Variant
+    Dim ptable As String
+    
+    Dim rx As Object
+    Set rx = CreateObject("vbscript.regexp")
+    rx.Global = True
+    rx.Pattern = " - .*"
+    
+    For i = 0 To Me.lbSWAP.ListCount - 1
+        If Me.lbSWAP.Selected(i) Then
+            vSwap(swapline, 2) = rx.Replace(cbPLIST.value, "")
+            return_swap = True
+            lbSWAP.list = vSwap
+            return_swap = False
+        End If
+    Next i
+    
+    vtable = x.ARRAYp_TransposeVar(vSwap)
+    vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
+    vtable = x.ARRAYp_TransposeVar(vtable)
+    ptable = x.json_from_table_zb(vtable, "rows", False)
+    Set jswap("swap") = JsonConverter.ParseJson(ptable)
+    
+    jswap("scenario")("version") = handler.plan
+    jswap("scenario")("iter") = handler.basis
+    jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
+    jswap("user") = Application.UserName
+    jswap("source") = "adj"
+    jswap("message") = tbCOM.text
+    jswap("tag") = cbTAG.text
+    jswap("type") = "swap"
+    
+    tbAPI.text = JsonConverter.ConvertToJson(jswap)
+    
+End Sub
+
+Private Sub dbGETSWAP_Click()
+
+    Dim doc As String
+    Dim j As Object
+    Dim fail As Boolean
+    Dim l() As Variant
+    Dim ptable As String
+    Dim vtable() As Variant
+    
+    Set j = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}")
+    'Set j = JsonConverter.ParseJson(doc)
+    j("new_mold") = pickSWAP.text
+    doc = JsonConverter.ConvertToJson(j)
+    vSwap = handler.get_swap_fit(doc, fail)
+    lbSWAP.list = vSwap
+    'Call x.frmListBoxHeader(lbSWAPH, lbSWAP, "Original", "Sales", "Replacement", "Fit")
+    
+    cbPLIST.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
+    
+    '---------build change-------------
+    Set jswap = j
+    vtable = x.ARRAYp_TransposeVar(vSwap)
+    vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
+    vtable = x.ARRAYp_TransposeVar(vtable)
+    ptable = x.json_from_table_zb(vtable, "rows", False)
+    Set jswap("swap") = JsonConverter.ParseJson(ptable)
+    
+    jswap("scenario")("version") = handler.plan
+    jswap("scenario")("iter") = handler.basis
+    jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
+    jswap("user") = Application.UserName
+    jswap("source") = "adj"
+    jswap("message") = tbCOM.text
+    jswap("tag") = cbTAG.text
+    jswap("type") = "swap"
+    
+    tbAPI.text = JsonConverter.ConvertToJson(jswap)
+    
+    
+End Sub
+
+
+Private Sub lbSWAP_Change()
+    
+    Dim i As Long
+    If return_swap Then Exit Sub
+
+    For i = 0 To Me.lbSWAP.ListCount - 1
+        If Me.lbSWAP.Selected(i) Then
+            set_swapalt = True
+            cbPLIST.value = vSwap(i, 2)
+            set_swapalt = False
+            swapline = i
+        End If
+    Next i
 
 End Sub
 
+Private Sub lbSWAP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
+    
+'    Dim rx As Object
+'    Set rx = CreateObject("vbscript.regexp")
+'    rx.Global = True
+'    rx.Pattern = " - .*"
+'    Dim match As Object
+'    Dim i As Long
+'    Dim v As Variant
+'
+'    'v = Me.lbSWAP.list
+'
+'    For i = 0 To Me.lbSWAP.ListCount - 1
+'        If Me.lbSWAP.Selected(i) Then
+'            part.Show
+'            If Not part.useval Then
+'                Exit Sub
+'            End If
+'            'vSwap(i, 3) = rx.Execute(part.cbPart.value)
+'            'v(i, 2) = rx.Replace(part.cbPart.value, "")
+'            'Me.lbSWAP.list = v
+'        End If
+'    Next i
+'
+End Sub
+
+
 Private Sub opEditPrice_Click()
 
     opPlugVol.Enabled = False
@@ -424,6 +570,7 @@ Private Sub UserForm_Activate()
     Me.lheader = "Loading..."
 
     Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
+    Call x.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
     
     Me.lheader = "Ready"
     
@@ -579,10 +726,17 @@ Private Sub UserForm_Activate()
     End If
     
     '----------reset spinner buttons----------------------
-    sbpd.value = 0
+    sbpv.value = 0
     sbpp.value = 0
     sbpd.value = 0
     
+    '--------reset swap tab-------------------------------
+    lbSWAP.clear
+    pickSWAP.value = ""
+    pickSWAP.text = ""
+    pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F1672"))
+    Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
+    
     Call handler.month_tosheet(month, basket)
     Application.StatusBar = False
     

handler.bas

@@ -5,7 +5,7 @@ Public sql As String
 Public jsql As String
 Public scenario As String
 Public sc() As Variant
-Public X As New TheBigOne
+Public x As New TheBigOne
 Public wapi As New Windows_API
 Public data() As String
 Public agg() As String
@@ -26,7 +26,7 @@ Sub load_fpvt()
     Dim i As Long
     Dim s_tot As Object
     
-    fpvt.ListBox1.list = handler.sc
+    fpvt.lbSDET.list = handler.sc
     
     showprice = False
     
@@ -182,7 +182,7 @@ Sub pg_main_workset(rep As String)
     ReDim str(UBound(res, 1), UBound(res, 2))
     
     Worksheets("data").Cells.ClearContents
-    Call X.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
+    Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
     
 
 End Sub
@@ -309,7 +309,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
         i = i + 1
     Loop
     
-    Call X.SHTp_DumpVar(res, "data", i, 1, False, False, True)
+    Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
     
     
     'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
@@ -453,8 +453,8 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
     
     'basket
     sh.Range("U1:AC100000").ClearContents
-    Call X.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
-    Call X.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
+    Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
+    Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
     Sheets("config").Cells(5, 2) = 0
     Sheets("config").Cells(6, 2) = 0
     Sheets("config").Cells(7, 2) = 0
@@ -589,3 +589,49 @@ Sub history()
     changes.Show
 
 End Sub
+
+Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Integer
+    Dim j As Integer
+    Dim res() As Variant
+    
+    If doc = "" Then
+        fail = True
+        Exit Function
+    End If
+    
+    server = Sheets("config").Cells(1, 2)
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/swap_fit", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+    
+    Set json = JsonConverter.ParseJson(wr)
+    
+    If IsNull(json("x")) Then
+        MsgBox ("no history")
+        fail = True
+        Exit Function
+    End If
+    
+    ReDim res(json("x").Count - 1, 3)
+    
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("part")
+        res(i, 1) = json("x")(i + 1)("value_usd")
+        res(i, 2) = json("x")(i + 1)("swap")
+        res(i, 3) = json("x")(i + 1)("fit")
+    Next i
+    
+    get_swap_fit = res
+
+End Function

months.cls

@@ -9,7 +9,7 @@ Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = True
 Option Explicit
 
-Private X As New TheBigOne
+Private x As New TheBigOne
 Private units() As Variant
 Private price() As Variant
 Private sales() As Variant
@@ -34,7 +34,7 @@ Private did_load_config As Boolean
 
 Private Sub cbMTAG_Change()
 
-
+    
 
 End Sub
 
@@ -126,11 +126,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
     End If
 End Sub
 
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
+Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
 
     If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
-        cancel = True
+        Cancel = True
         Call Me.basket_pick(Target)
         Target.Select
     End If
@@ -146,10 +146,10 @@ Sub picker_shortcut()
 
 End Sub
 
-Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, cancel As Boolean)
+Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
     If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
-        cancel = True
+        Cancel = True
         Call Me.basket_pick(Target)
         Target.Select
     End If
@@ -361,7 +361,7 @@ Sub set_sheet()
     Range("H18:L18").FormulaR1C1 = tprice
     Range("N18:R18").FormulaR1C1 = tsales
     Range("T6:U18").ClearContents
-    Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
+    Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
     'Sheets("month").Range("B32:Q5000").ClearContents
     
     If Me.newpart Then
@@ -388,7 +388,7 @@ Sub load_sheet()
     tsales = Range("N18:R18")
     'reset basket
     Sheets("_month").Range("U1:X10000").ClearContents
-    Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
+    Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
     ReDim adjust(12)
     Call Me.crunch_array
     Call Me.set_sheet
@@ -558,6 +558,7 @@ Sub build_json()
         Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]")
         np("source") = "adj"
         np("type") = "new_basket"
+        np("tag") = cbMTAG.text
         Set m = JsonConverter.ParseJson("{}")
     End If
     
@@ -619,9 +620,9 @@ Sub build_json()
         'np("basket") = x.json_from_table(b, "basket", False)
         'get the basket from the sheet
         b = Worksheets("_month").Range("U1").CurrentRegion.value
-        Set m = JsonConverter.ParseJson(X.json_from_table(b, "basket", False))
+        Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
         If UBound(b, 1) <= 2 Then
-            Set np("basket") = JsonConverter.ParseJson("[" & X.json_from_table(b, "basket", False) & "]")
+            Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
         Else
             Set np("basket") = m("basket")
         End If
@@ -686,7 +687,7 @@ Sub crunch_array()
 
 End Sub
 
-Sub cancel()
+Sub Cancel()
 
     Sheets("Orders").Select
 
@@ -726,7 +727,7 @@ Sub print_basket()
 
     Dim i As Long
     Dim basket() As Variant
-    basket = X.SHTp_get_block(Sheets("_month").Range("U1"))
+    basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
     
     dumping = True
     
@@ -839,7 +840,7 @@ Sub get_edit_basket()
     dumping = False
     
     Worksheets("_month").Range("U2:X5000").ClearContents
-    Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
+    Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
     
     If Me.newpart Then
         Me.build_json
@@ -910,7 +911,7 @@ Sub build_new()
     'Call Me.set_sheet
     'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
     
-    basket = X.SHTp_get_block(Worksheets("_month").Range("U1"))
+    basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
     Sheets("month").Cells(32, 2) = basket(1, 1)
     Sheets("month").Cells(32, 6) = basket(1, 2)
     Sheets("month").Cells(32, 12) = basket(1, 3)
@@ -933,8 +934,8 @@ Sub new_part()
     
     '---------build customer mix-------------------------------------------------------------------
     
-    cust = X.SHTp_Get("_month", 1, 27, True)
-    If Not X.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
+    cust = x.SHTp_Get("_month", 1, 27, True)
+    If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
         MsgBox ("error building customer mix")
     End If
     
@@ -978,8 +979,8 @@ Sub new_part()
         i = i + 1
     Loop
     Worksheets("_month").Range("U2:AC10000").ClearContents
-    Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
-    Call X.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
+    Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
+    Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
     
     '------reset volume to copy base to forecsat and clear base------------------------------------
     

pivot.cls

@@ -13,9 +13,9 @@ Private Sub Worksheet_Activate()
 
 End Sub
 
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
+Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
-    If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
+    If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
         Exit Sub
     End If
 
@@ -25,7 +25,7 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean
         Exit Sub
     End If
 
-    cancel = True
+    Cancel = True
 
     Dim i As Long
     Dim j As Long