UI and UX Changes

1. Remove/Hide Swap Part
2. Remove/Hide Swap Customer
3. Improved the location of controls on fpvt form.
4. Make user experience more intuitive on the Month sheet
5. Make more and better use of named ranges in place of hardcoded cell
   locations.
6. Added error checking to ensure Tag is entered and at least one month
   has a forecast on Month sheet.

VBA/fpvt.frm

@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt 
    Caption         =   "Forecast Adjustment"
-   ClientHeight    =   8445.001
+   ClientHeight    =   8595.001
    ClientLeft      =   120
    ClientTop       =   465
-   ClientWidth     =   8805.001
+   ClientWidth     =   8670.001
    OleObjectBlob   =   "fpvt.frx":0000
    StartUpPosition =   1  'CenterOwner
 End
@@ -81,7 +81,7 @@ Private Sub butAdjust_Click()
         Exit Sub
     End If
     
-    If cbTAG.text = "" Then
+    If cbTag.text = "" Then
         MsgBox ("no tag was selected")
         Exit Sub
     End If
@@ -112,7 +112,7 @@ Private Sub butAdjust_Click()
     End If
     
     Me.tbCOM = ""
-    Me.cbTAG.text = ""
+    Me.cbTag.text = ""
     
     Me.Hide
     
@@ -150,12 +150,12 @@ End Sub
 
 Private Sub cbGoSheet_Click()
 
-    shMonthView.tbMCOM.text = ""
+    shMonthView.Range("MonthComment").value = ""
-    shMonthView.sbMPV.value = 0
+    shMonthView.Cells(19, 5).value = 0
-    shMonthView.sbMPP.value = 0
+    shMonthView.Cells(19, 11).value = 0
     
     Me.Hide
-    shMonthView.cbMTAG.value = ""
+    shMonthView.Range("MonthTags").value = ""
     shMonthView.Visible = xlSheetVisible
     shMonthView.Select
 
@@ -167,7 +167,7 @@ Private Sub cbTAG_Change()
     Dim j As Object
     If tbAPI.text = "" Then tbAPI.text = "{}"
     Set j = JsonConverter.ParseJson(tbAPI.text)
-    j("tag") = cbTAG.value
+    j("tag") = cbTag.value
     tbAPI.text = JsonConverter.ConvertToJson(j)
     
 End Sub
@@ -242,7 +242,7 @@ Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift
     jswap("user") = Application.UserName
     jswap("source") = "adj"
     jswap("message") = tbCOM.text
-    jswap("tag") = cbTAG.text
+    jswap("tag") = cbTag.text
     jswap("type") = "swap"
     
     tbAPI.text = JsonConverter.ConvertToJson(jswap)
@@ -282,7 +282,7 @@ Private Sub dbGETSWAP_Click()
     jswap("user") = Application.UserName
     jswap("source") = "adj"
     jswap("message") = tbCOM.text
-    jswap("tag") = cbTAG.text
+    jswap("tag") = cbTag.text
     jswap("type") = "swap"
     
     tbAPI.text = JsonConverter.ConvertToJson(jswap)
@@ -587,17 +587,16 @@ Private Sub UserForm_Activate()
     Dim j As Long
     Dim k As Long
     Dim ok As Boolean
-    Dim tags() As Variant
+'    Dim tags() As Variant
     
-    Me.Caption = "Forecast Adjust " & shConfig.Cells(8, 2)
+    Me.Caption = "Forecast Adjust " & shConfig.Range("version").value & "   Loading..."
     Me.mp.Visible = False
-    
+    Me.fraExit.Visible = False
-    Me.lheader = "Loading..."
     
     Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
     Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
     
-    Me.lheader = "Ready"
+    Me.Caption = "Forecast Adjust " & shConfig.Range("version").value
     
     If Not ok Then
         fpvt.Hide
@@ -753,16 +752,7 @@ Private Sub UserForm_Activate()
     
     
     '-------------load tags-------------------------------
-    If Not IsNull(sp("package")("tags")) Then
+    cbTag.list = shConfig.ListObjects("TAGS").DataBodyRange.value
-        ReDim tags(sp("package")("tags").Count - 1, 0)
-        For i = 1 To sp("package")("tags").Count
-            tags(i - 1, 0) = sp("package")("tags")(i)
-        Next i
-        cbTAG.list = tags
-        shMonthView.cbMTAG.list = tags
-        cbTAG.ListRows = UBound(tags, 1) + 1
-        shMonthView.cbMTAG.ListRows = UBound(tags, 1) + 1
-    End If
     
     '----------reset spinner buttons----------------------
     sbpv.value = 0
@@ -796,7 +786,7 @@ Private Sub UserForm_Activate()
     Application.StatusBar = False
     
     Me.mp.Visible = True
-    
+    Me.fraExit.Visible = True
     
 End Sub
 
@@ -906,7 +896,7 @@ Sub build_cust_swap()
     cswap("user") = Application.UserName
     cswap("source") = "adj"
     cswap("message") = tbCOM.text
-    cswap("tag") = cbTAG.text
+    cswap("tag") = cbTag.text
     cswap("type") = "cust_swap"
     Set cswap("swap") = JsonConverter.ParseJson(ptable)
     
@@ -1092,7 +1082,7 @@ Sub calc_val()
     adjust("user") = Application.UserName
     adjust("source") = "adj"
     adjust("message") = tbCOM.text
-    adjust("tag") = cbTAG.text
+    adjust("tag") = cbTag.text
     If opEditSales Then
         If opPlugVol Then
             adjust("type") = "scale_v"
@@ -1146,7 +1136,7 @@ Sub calc_price()
     adjust("user") = Application.UserName
     adjust("source") = "adj"
     adjust("message") = tbCOM.text
-    adjust("tag") = cbTAG.text
+    adjust("tag") = cbTag.text
     adjust("version") = handler.plan
     
     If opEditSales Then

VBA/handler.bas

@@ -98,6 +98,12 @@ Sub pg_main_workset(rep As String)
         Exit Sub
     End If
     Set json = JsonConverter.ParseJson(wr)
+    
+    If IsNull(json("x")) Then
+        MsgBox "No data found for " & rep & "."
+        Exit Sub
+    End If
+    
     ReDim res(json("x").Count, 33)
     
     For i = 1 To UBound(res, 1)
@@ -209,7 +215,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
     'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
     'doc = JsonConverter.ConvertToJson(doc)
     
-    server = shConfig.Cells(1, 2)
+    server = shConfig.Range("server").value
     
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
@@ -322,41 +328,31 @@ End Function
 Sub load_config()
 
     Dim i As Integer
-    Dim j As Integer
     '----server to use---------------------------------------------------------
-    handler.server = shConfig.Cells(1, 2)
+    handler.server = shConfig.Range("server").value
     '---basis-----------------------------------------------------------------
-    ReDim handler.basis(100)
+    With shConfig.ListObjects("BASIS")
-    i = 2
+        For i = 1 To .DataBodyRange.Rows.Count
-    j = 0
+            ReDim Preserve handler.basis(i - 1)
-    Do While shConfig.Cells(2, i) <> ""
+            handler.basis(i - 1) = .DataBodyRange(i, 1)
-        handler.basis(j) = shConfig.Cells(2, i)
+        Next
-        j = j + 1
+    End With
-        i = i + 1
-    Loop
-    ReDim Preserve handler.basis(j - 1)
     '---baseline-----------------------------------------------------------------
-    ReDim handler.baseline(100)
+    With shConfig.ListObjects("BASELINE")
-    i = 2
+        For i = 1 To .DataBodyRange.Rows.Count
-    j = 0
+            ReDim Preserve handler.baseline(i - 1)
-    Do While shConfig.Cells(3, i) <> ""
+            handler.baseline(i - 1) = .DataBodyRange(i, 1)
-        handler.baseline(j) = shConfig.Cells(3, i)
+        Next
-        j = j + 1
+    End With
-        i = i + 1
-    Loop
-    ReDim Preserve handler.baseline(j - 1)
     '---adjustments-----------------------------------------------------------------
-    ReDim handler.adjust(100)
+    With shConfig.ListObjects("ADJUST")
-    i = 2
+        For i = 1 To .DataBodyRange.Rows.Count
-    j = 0
+            ReDim Preserve handler.adjust(i - 1)
-    Do While shConfig.Cells(4, i) <> ""
+            handler.adjust(i - 1) = .DataBodyRange(i, 1)
-        handler.adjust(j) = shConfig.Cells(4, i)
+        Next
-        j = j + 1
+    End With
-        i = i + 1
-    Loop
-    ReDim Preserve handler.adjust(j - 1)
     '---plan version--------------------------------------------------------------
-    handler.plan = shConfig.Cells(9, 2)
+    handler.plan = shConfig.Range("budget").value
     
 End Sub
 
@@ -456,9 +452,9 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
         .Range("U1:AC100000").ClearContents
         Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True)
         Call Utils.SHTp_DumpVar(basket, .Name, 1, 26, False, False, True)
-        shConfig.Cells(5, 2) = 0
+        shConfig.Range("rebuild").value = 0
-        shConfig.Cells(6, 2) = 0
+        shConfig.Range("show_basket").value = 0
-        shConfig.Cells(7, 2) = 0
+        shConfig.Range("new_part").value = 0
         
         shMonthView.load_sheet
     
@@ -491,7 +487,7 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
         Exit Function
     End If
     
-    server = shConfig.Cells(1, 2)
+    server = shConfig.Range("server").value
     
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
@@ -604,7 +600,7 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
         Exit Function
     End If
     
-    server = shConfig.Cells(1, 2)
+    server = shConfig.Range("server").value
     
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All

VBA/openf.frm

@@ -34,7 +34,7 @@ End Sub
 Private Sub UserForm_Activate()
 
     'handler.server = "http://192.168.1.69:3000"
-    handler.server = shConfig.Cells(1, 2)
+    handler.server = shConfig.Range("server").value
     
     openf.Caption = "Select a DSM"
     cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value

VBA/shMonthView.cls

@@ -19,7 +19,6 @@ 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
@@ -29,21 +28,38 @@ Private np As Object 'json dedicated to new part scenario
 Private b() As Variant 'holds basket
 Private did_load_config As Boolean
 
+Public Sub MPP_Down()   ' Handler for down-triangle on price percent change.
+    If newpart Then Exit Sub
     
-Private Sub sbMPP_Change()
+    With shMonthView.Range("PricePctChange")
-    Dim m As Worksheet
+        .value = WorksheetFunction.Max(-0.1, .value - 0.01)
+    End With
+    MPP_Change
+End Sub
+
+Public Sub MPP_Up()   ' Handler for up-triangle on price percent change.
+    If newpart Then Exit Sub
+    
+    With shMonthView.Range("PricePctChange")
+        .value = WorksheetFunction.Min(0.1, .value + 0.01)
+    End With
+    MPP_Change
+End Sub
+
+Private Sub MPP_Change()
     Dim i As Long
     
     Application.ScreenUpdating = False
     
     dumping = True
     
-    Set m = shMonthView
+    With shMonthView
-    m.Cells(19, 11) = sbMPP.value / 100
+        For i = 1 To 12
-    For i = 6 To 17
+            If .Range("PriceBaseline").Cells(i) > 0 Then
-        m.Cells(i, 11) = (m.Cells(i, 9)) * m.Cells(19, 11)
+                .Range("PriceNewAdj").Cells(i) = .Range("PriceBaseline").Cells(i) * .Range("PricePctChange")
+            End If
         Next i
-    
+    End With
     Me.mvp_adj
     
     dumping = False
@@ -52,45 +68,55 @@ Private Sub sbMPP_Change()
 End Sub
 
 
-Private Sub sbMPV_Change()
+Public Sub MPV_Down()   ' Handler for down-triangle on qty percent change.
-    Dim m As Worksheet
+    If newpart Then Exit Sub
+    
+    With shMonthView.Range("QtyPctChange")
+        .value = WorksheetFunction.Max(-0.1, .value - 0.01)
+    End With
+    MPV_Change
+End Sub
+
+Public Sub MPV_Up()   ' Handler for up-triangle on qty percent change.
+    If newpart Then Exit Sub
+    
+    With shMonthView.Range("QtyPctChange")
+        .value = WorksheetFunction.Min(0.1, .value + 0.01)
+    End With
+    MPV_Change
+End Sub
+
+Private Sub MPV_Change()
     Dim i As Long
     
     Application.ScreenUpdating = False
     
     dumping = True
     
-    Set m = shMonthView
+    With shMonthView
-    m.Cells(19, 5) = sbMPV.value / 100
+        For i = 1 To 12
-    For i = 6 To 17
+            If .Range("QtyBaseline").Cells(i) <> 0 Then
-        If m.Cells(i, 5) <> "" Then
+                .Range("QtyNewAdj").Cells(i) = .Range("QtyBaseline").Cells(i) * .Range("QtyPctChange")
-            m.Cells(i, 5) = (m.Cells(i, 3)) * m.Cells(19, 5)
             End If
         Next i
+    End With
     
     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 because % increase spinners are flagged as dumps
-    '---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 dumping Then Exit Sub
         
     If Not Intersect(Target, Range("A1:R18")) Is Nothing Then
         If Target.Columns.Count > 1 Then
@@ -102,37 +128,31 @@ Private Sub Worksheet_Change(ByVal Target As Range)
         End If
     End If
     
-        If Not Intersect(Target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
+    If Not Intersect(Target, Range("QtyNewAdj")) 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("QtyFinal")) 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("PriceNewAdj")) 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("PriceFinal")) 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("SalesNewAdj")) 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("SalesFinal")) Is Nothing Then Call Me.ms_set
     
-        If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
+    If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
         Set basket_touch = Target
         Call Me.get_edit_basket
         Set basket_touch = Nothing
     End If
-        
-    End If
 End Sub
 
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-
+    If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
-
-    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("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
-    If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
         Call Me.basket_pick(Selection)
     End If
 
@@ -140,7 +160,7 @@ 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
+    If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
         Cancel = True
         Call Me.basket_pick(Target)
         Target.Select
@@ -220,7 +240,7 @@ On Error GoTo errh
     Dim i As Integer
     Call Me.get_sheet
     Dim vp As String
-    vp = shMonthView.Range("Q2")
+    vp = shMonthView.Range("MonthVariable")
 
     For i = 1 To 12
         If sales(i, 5) = "" Then sales(i, 5) = 0
@@ -276,7 +296,7 @@ Sub ms_adj()
     Dim i As Integer
     Call Me.get_sheet
     Dim vp As String
-    vp = shMonthView.Range("Q2")
+    vp = shMonthView.Range("MonthVariable")
 
     For i = 1 To 12
         If sales(i, 4) = "" Then sales(i, 4) = 0
@@ -329,30 +349,33 @@ Sub get_sheet()
 
     Dim i As Integer
     
-    units = Range("B6:F17")
+    units = Range("units")
-    price = Range("H6:L17")
+    price = Range("price")
-    sales = Range("N6:R17")
+    sales = Range("sales")
-    tunits = Range("B18:F18")
+    tunits = Range("tunits")
-    tprice = Range("H18:L18")
+    tprice = Range("tprice")
-    tsales = Range("N18:R18")
+    tsales = Range("tsales")
     ReDim adjust(12)
-    Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
       
 End Sub
 
+Private Function basejson() As Object
+    Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
+End Function
+
 Sub set_sheet()
 
     Dim i As Integer
 
     dumping = True
     
-    Range("B6:F17") = units
+    Range("units") = units
-    Range("H6:L17") = price
+    Range("price") = price
-    Range("N6:R17") = sales
+    Range("sales") = sales
-    Range("B18:F18").FormulaR1C1 = tunits
+    Range("tunits").FormulaR1C1 = tunits
-    Range("H18:L18").FormulaR1C1 = tprice
+    Range("tprice").FormulaR1C1 = tprice
-    Range("N18:R18").FormulaR1C1 = tsales
+    Range("tsales").FormulaR1C1 = tsales
-    Range("T6:U18").ClearContents
+    Range("scenario").ClearContents
     Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("R1")), shMonthView.Name, 6, 20, False, False, False)
     'shMonthView.Range("B32:Q5000").ClearContents
     
@@ -375,9 +398,9 @@ Sub load_sheet()
     price = shMonthUpdate.Range("F2:J13").FormulaR1C1
     sales = shMonthUpdate.Range("K2:O13").FormulaR1C1
     scenario = shMonthUpdate.Range("R1:S13").FormulaR1C1
-    tunits = Range("B18:F18")
+    tunits = Range("tunits")
-    tprice = Range("H18:L18")
+    tprice = Range("tprice")
-    tsales = Range("N18:R18")
+    tsales = Range("tsales")
     'reset basket
     shMonthUpdate.Range("U1:X10000").ClearContents
     Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("Z1")), shMonthUpdate.Name, 1, 21, False, False, False)
@@ -402,17 +425,17 @@ Sub set_format()
     Dim val_adj As Range
     Dim val_set As Range
     
-    Set prices = shMonthView.Range("H6:L17")
+    Set prices = shMonthView.Range("price")
-    Set price_adj = shMonthView.Range("K6:K17")
+    Set price_adj = shMonthView.Range("PriceNewAdj")
-    Set price_set = shMonthView.Range("L6:L17")
+    Set price_set = shMonthView.Range("PriceFinal")
     
-    Set vol = shMonthView.Range("B6:F17")
+    Set vol = shMonthView.Range("units")
-    Set vol_adj = shMonthView.Range("E6:E17")
+    Set vol_adj = shMonthView.Range("QtyNewAdj")
-    Set vol_set = shMonthView.Range("F6:F17")
+    Set vol_set = shMonthView.Range("QtyFinal")
     
-    Set val = shMonthView.Range("N6:R17")
+    Set val = shMonthView.Range("sales")
-    Set val_adj = shMonthView.Range("Q6:Q17")
+    Set val_adj = shMonthView.Range("SalesNewAdj")
-    Set val_set = shMonthView.Range("R6:R17")
+    Set val_set = shMonthView.Range("SalesFinal")
     
     Call Me.format_price(prices)
     Call Me.set_border(prices)
@@ -530,27 +553,19 @@ Sub build_json()
     Dim m As Object
     Dim list As Object
 
-    ReDim handler.basis(100)
+    load_config
-    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))
+        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
+        np("tag") = shMonthView.Range("MonthTags").value
         Set m = JsonConverter.ParseJson("{}")
     End If
     
@@ -565,7 +580,7 @@ Sub build_json()
         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))
+                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
@@ -692,26 +707,16 @@ Sub reset()
 End Sub
 
 Sub switch_basket()
-
+    shConfig.Range("show_basket").value = 1 - shConfig.Range("show_basket").value
-
-    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.Range("show_basket").value = 0 Then
-    If shConfig.Cells(6, 2) = 0 Then
         dumping = True
-        shMonthView.Range("B32:Q10000").ClearContents
+        shMonthView.Range("basket").ClearContents
-        Rows("20:31").Hidden = False
+'        Rows("20:31").Hidden = False
         dumping = False
         Exit Sub
     End If
@@ -722,7 +727,7 @@ Sub print_basket()
     
     dumping = True
     
-    shMonthView.Range("B32:Q10000").ClearContents
+    shMonthView.Range("basket").ClearContents
     For i = 1 To UBound(basket, 1)
         shMonthView.Cells(31 + i, 2) = basket(i, 1)
         shMonthView.Cells(31 + i, 6) = basket(i, 2)
@@ -844,16 +849,29 @@ End Sub
 
 
 Sub post_adjust()
-    
     Dim i As Long
+    Dim msg As String
+    If Not Me.newpart Then
+        msg = "Make sure at least one month has Final values for Volume, Price, and Sales."
+        For i = 2 To 13
+            If shMonthUpdate.Cells(i, 16) <> "" Then msg = ""
+        Next i
+    End If
+    If IsEmpty(shMonthView.Range("MonthTags").value) Then msg = "You need to specify a tag for this update."
+    
+    If msg <> "" Then
+        MsgBox msg, vbOKOnly Or vbExclamation
+        Exit Sub
+    End If
+        
     Dim fail As Boolean
     Dim adjust As Object
     Dim jdoc As String
     
     If Me.newpart Then
         Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(2, 16))
-        adjust("message") = Me.tbMCOM.text
+        adjust("message") = shMonthView.Range("MonthComment").value
-        adjust("tag") = Me.cbMTAG.text
+        adjust("tag") = shMonthView.Range("MonthTags").value
         jdoc = JsonConverter.ConvertToJson(adjust)
         Call handler.request_adjust(jdoc, fail)
         If fail Then Exit Sub
@@ -861,8 +879,8 @@ Sub post_adjust()
         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("message") = shMonthView.Range("MonthComment").value
-                adjust("tag") = Me.cbMTAG.text
+                adjust("tag") = shMonthView.Range("MonthTags").value
                 jdoc = JsonConverter.ConvertToJson(adjust)
                 Call handler.request_adjust(jdoc, fail)
                 If fail Then Exit Sub
@@ -877,7 +895,7 @@ End Sub
 
 Sub build_new()
 
-    shConfig.Cells(5, 2) = 1
+    shConfig.Range("rebuild").value = 1
     Dim i As Long
     Dim j As Long
     Dim basket() As Variant
@@ -938,7 +956,7 @@ Sub new_part()
     
     dumping = True
     
-    shMonthView.Range("B33:Q10000").ClearContents
+    shMonthView.Range("basket").ClearContents
     
     For i = 1 To UBound(cust, 2)
         shMonthView.Cells(32 + i, 2) = part.cbPart.value
@@ -947,7 +965,7 @@ Sub new_part()
         shMonthView.Cells(32 + i, 17) = CDbl(cust(2, i))
     Next i
     
-    shConfig.Cells(7, 2) = 1
+    shConfig.Range("new_part").value = 1
     
     '------copy revised basket to _month storage---------------------------------------------------
     
@@ -980,7 +998,6 @@ Sub new_part()
     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)
@@ -1013,20 +1030,12 @@ Sub new_part()
     
     
     'force basket to show to demonstrate the part was changed
-    shConfig.Cells(6, 2) = 1
+    shConfig.Range("show_basket").value = 1
     Call Me.print_basket
     dumping = False
     
 End Sub
 
 Function newpart() As Boolean
-
+    newpart = shConfig.Range("new_part").value = 1
-    If shConfig.Cells(7, 2) = 1 Then
-        newpart = True
-    Else
-        newpart = False
-    End If
-    
 End Function
-
-

VBA/shWalk.cls

@@ -7,9 +7,9 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = True
-' Option Explicit
+'Option Explicit
 '
-' Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
+'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 '    Dim pt As PivotTable
 '    Set pt = ActiveSheet.PivotTables("ptWalk")
 '    Dim intersec As Range
@@ -63,9 +63,9 @@ Attribute VB_Exposed = True
 '    Call handler.load_config
 '    Call handler.load_fpvt
 '
-' End Sub
+'End Sub
 '
-' Function piv_pos(list As Object, target_pos As Long) As Long
+'Function piv_pos(list As Object, target_pos As Long) As Long
 '
 '    Dim i As Long
 '
@@ -77,9 +77,9 @@ Attribute VB_Exposed = True
 '    Next i
 '    'should not get to this point
 '
-' End Function
+'End Function
 '
-' Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
+'Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
 '
 '    Dim i As Integer
 '
@@ -90,25 +90,25 @@ Attribute VB_Exposed = True
 '        End If
 '    Next i
 '
-' End Function
+'End Function
 '
-' Function escape_json(ByVal text As String) As String
+'Function escape_json(ByVal text As String) As String
 '
 '    text = Replace(text, "'", "''")
 '    text = Replace(text, """", "\""")
 '    If text = "(blank)" Then text = ""
 '    escape_json = text
 '
-' End Function
+'End Function
 '
-' Function escape_sql(ByVal text As String) As String
+'Function escape_sql(ByVal text As String) As String
 '
 '    text = Replace(text, "'", "''")
 '    text = Replace(text, """", """""")
 '    If text = "(blank)" Then text = ""
 '    escape_sql = text
 '
-' End Function
+'End Function
 '
 '