Clean up the VBA. This coincides with version 10.0 in Teams.

WARNING!  Do not assume the Excel file in this repo matches the VBA in
the repo. The decision was made to use Teams for managing changes to the
Excel tamplate because Git is ill-suited for binary files. The Excel
file will be updated from time to time, but only when something major
happens with the application as a whole.

1. Use the sheets' codenames to refer to them in code. This prevents
   breakage if the user changes the sheet name while working with the
   workbook.
2. Give the pivot tables proper, if not descriptive, names.
3. Simplify the code that detects a double-click in the pivot table.
4. Remove Windows_API as it was not being used.
5. Pare down TheBigOne to just the essential functions in Utils.
6. Refer to the data sources for the userforms' listboxes by using the
   worksheet.ListObjects collection.

VBA/JsonDebugPrint.bas

@@ -3,8 +3,8 @@ Option Explicit
 
 
 Public Sub TestPrintJSON()
-    PrintJSON ParseJSON("[1,2,3]")
+    PrintJSON ParseJson("[1,2,3]")
-    PrintJSON ParseJSON("[{""a"":123,""b"":[56,7,78]}]")
+    PrintJSON ParseJson("[{""a"":123,""b"":[56,7,78]}]")
 End Sub
 
 ' This is definitely NOT a pretty printer. It was written merely as a debugging

VBA/ThisWorkbook.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ThisWorkbook"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

VBA/Windows_API.cls

@@ -1,247 +0,0 @@
-VERSION 1.0 CLASS
-BEGIN
-  MultiUse = -1  'True
-END
-Attribute VB_Name = "Windows_API"
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Option Explicit
-
-Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
-Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
-Private Declare PtrSafe Function GetClipboardOwner Lib "user32" () As LongPtr
-Private Declare PtrSafe Function SetClipboardViewer Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
-Private Declare PtrSafe Function GetClipboardViewer Lib "user32" () As LongPtr
-Private Declare PtrSafe Function ChangeClipboardChain Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndNext As LongPtr) As Long
-Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
-Private Declare PtrSafe Function GetClipboardData Lib "user32" Alias "GetClipboardDataA" (ByVal wFormat As Long) As LongPtr
-Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
-Private Declare PtrSafe Function CountClipboardFormats Lib "user32" () As Long
-Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
-Private Declare PtrSafe Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" _
-    (ByVal wFormat As Long, _
-    ByVal lpString As String, _
-    ByVal nMaxCount As Long) As Long
-Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
-Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
-Private Declare PtrSafe Function GetPriorityClipboardFormat Lib "user32" (lpPriorityList As Long, ByVal nCount As Long) As Long
-Private Declare PtrSafe Function GetOpenClipboardWindow Lib "user32" () As LongPtr
-Private Declare PtrSafe Function CharToOem Lib "user32" Alias "CharToOemA" _
-    (ByVal lpszSrc As String, _
-     ByVal lpszDst As String) As Long
-Private Declare PtrSafe Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
-Private Declare PtrSafe Function CharToOemBuff Lib "user32" Alias "CharToOemBuffA" _
-    (ByVal lpszSrc As String, _
-    ByVal lpszDst As String, _
-    ByVal cchDstLength As Long) As Long
-Private Declare PtrSafe Function OemToCharBuff Lib "user32" Alias "OemToCharBuffA" _
-    (ByVal lpszSrc As String, _
-    ByVal lpszDst As String, _
-    ByVal cchDstLength As Long) As Long
-Private Declare PtrSafe Function CharUpper Lib "user32" Alias "CharUpperA" (ByVal lpsz As String) As String
-Private Declare PtrSafe Function CharUpperBuff Lib "user32" Alias "CharUpperBuffA" (ByVal lpsz As String, ByVal cchLength As Long) As Long
-Private Declare PtrSafe Function CharLower Lib "user32" Alias "CharLowerA" (ByVal lpsz As String) As String
-Private Declare PtrSafe Function CharLowerBuff Lib "user32" Alias "CharLowerBuffA" (ByVal lpsz As String, ByVal cchLength As Long) As Long
-Private Declare PtrSafe Function CharNext Lib "user32" Alias "CharNextA" (ByVal lpsz As String) As String
-Private Declare PtrSafe Function CharPrev Lib "user32" Alias "CharPrevA" (ByVal lpszStart As String, ByVal lpszCurrent As String) As String
-Private Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
-Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
-Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
-Private Declare PtrSafe Function GlobalHandle Lib "kernel32" (wMem As Any) As LongPtr
-Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
-Private Declare PtrSafe Function GlobalReAlloc Lib "kernel32" (ByVal hMem As LongPtr, ByVal dwBytes As LongPtr, ByVal wFlags As Long) As LongPtr
-Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
-Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
-Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" _
-    (ByRef lpMsg As MSG, ByVal hwnd As Long, _
-     ByVal wMsgFilterMin As Long, _
-     ByVal wMsgFilterMax As Long, _
-     ByVal wRemoveMsg As Long) As Long
-Private Declare PtrSafe Function TranslateMessage Lib "user32" _
-    (ByRef lpMsg As MSG) As Long
-Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
-    (ByVal hwnd As Long, _
-     ByVal wMsg As Long, _
-     ByVal wParam As Long, _
-     lParam As Any) As Long
-Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
-    (ByVal lpClassName As String, _
-     ByVal lpWindowName As String) As Long
-
-
-
-Private Type POINTAPI
-    x As Long
-    Y As Long
-End Type
-
-Private Type MSG
-    hwnd As Long
-    Message As Long
-    wParam As Long
-    lParam As Long
-    time As Long
-    pt As POINTAPI
-End Type
-
-Private Const WM_KEYDOWN As Long = &H100
-Private Const PM_REMOVE  As Long = &H1
-Private Const WM_CHAR    As Long = &H102
-Private Const GHND As Long = &H42
-Private Const CF_TEXT = 1
-Private Const MAXSIZE = 40096
-Private bExitLoop As Boolean
-
-
-
-Public Sub SetClipboard(sUniText As String)
-    Dim iStrPtr As LongPtr
-    Dim iLen As LongPtr
-    Dim iLock As LongPtr
-    Const GMEM_MOVEABLE As Long = &H2
-    Const GMEM_ZEROINIT As Long = &H40
-    Const CF_UNICODETEXT As Long = &HD
-    OpenClipboard 0&
-    EmptyClipboard
-    iLen = LenB(sUniText) + 2&
-    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
-    iLock = GlobalLock(iStrPtr)
-    lstrcpy iLock, StrPtr(sUniText)
-    GlobalUnlock iStrPtr
-    SetClipboardData CF_UNICODETEXT, iStrPtr
-    CloseClipboard
-End Sub
-
-Public Sub ClipBoard_SetData(sUniText As String)
-
-    
-    Dim hGlobalMemory As LongPtr
-    Dim lpGlobalMemory As LongPtr
-    Dim hClipMemory As LongPtr
-    Dim x As Long
-    
-    hGlobalMemory = GlobalAlloc(GHND, Len(sUniText) + 1)
-    
-    lpGlobalMemory = GlobalLock(hGlobalMemory)
-    
-    lpGlobalMemory = lstrcpy(lpGlobalMemory, sUniText)
-    
-    If GlobalUnlock(hGlobalMemory) <> 0 Then
-        GoTo OutOfHere2
-    End If
-    
-    If OpenClipboard(0&) = 0 Then
-        Exit Sub
-    End If
-    
-    x = EmptyClipboard()
-    
-    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
-    
-OutOfHere2:
-    
-    If CloseClipboard() = 0 Then
-        MsgBox ("ruh-roh")
-    End If
-
-End Sub
-
-Public Function GetClipboard() As String
-    Dim iStrPtr As Long
-    Dim iLen As Long
-    Dim iLock As Long
-    Dim sUniText As String
-    Const CF_UNICODETEXT As Long = 13&
-    OpenClipboard 0&
-    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
-        iStrPtr = GetClipboardData(CF_UNICODETEXT)
-        If iStrPtr Then
-            iLock = GlobalLock(iStrPtr)
-            iLen = GlobalSize(iStrPtr)
-            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
-            lstrcpy StrPtr(sUniText), iLock
-            GlobalUnlock iStrPtr
-        End If
-        GetClipboard = sUniText
-    End If
-    CloseClipboard
-End Function
-
-
-Sub TrackKeyPressInit()
-
-    Dim msgMessage As MSG
-    Dim bCancel As Boolean
-    Dim iKeyCode As Integer
-    Dim lXLhwnd As Long
-
-    On Error GoTo errHandler:
-        Application.EnableCancelKey = xlErrorHandler
-        'initialize this boolean flag.
-        bExitLoop = False
-        'get the app hwnd.
-        lXLhwnd = FindWindow("XLMAIN", Application.Caption)
-    Do
-        WaitMessage
-        'check for a key press and remove it from the msg queue.
-        If PeekMessage _
-            (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
-            'strore the virtual key code for later use.
-            iKeyCode = msgMessage.wParam
-           'translate the virtual key code into a char msg.
-            TranslateMessage msgMessage
-            PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
-            WM_CHAR, PM_REMOVE
-           'for some obscure reason, the following
-          'keys are not trapped inside the event handler
-            'so we handle them here.
-            If iKeyCode = vbKeyBack Then SendKeys "{BS}"
-            If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
-           'assume the cancel argument is False.
-            bCancel = False
-            'the VBA RaiseEvent statement does not seem to return ByRef arguments
-            'so we call a KeyPress routine rather than a propper event handler.
-            Sheet_KeyPress ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel
-            'if the key pressed is allowed post it to the application.
-            If bCancel = False Then
-                PostMessage _
-                lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
-            End If
-        End If
-errHandler:
-        'allow the processing of other msgs.
-        DoEvents
-    Loop Until bExitLoop
-
-End Sub
-
-Sub StopKeyWatch()
-
-    'set this boolean flag to exit the above loop.
-    bExitLoop = True
-
-End Sub
-
-
-'\\This example illustrates how to catch worksheet
-'\\Key strokes in order to prevent entering numeric
-'\\characters in the Range "A1:D10" .
-Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As Range, Cancel As Boolean)
-
-    Const MSG As String = "Numeric Characters are not allowed in" & vbNewLine & "the Range:  """
-    Const TITLE As String = "Invalid Entry !"
-
-    If Not Intersect(Target, Range("A1:D10")) Is Nothing Then
-        If Chr(KeyAscii) Like "[0-9]" Then
-            MsgBox MSG & Range("A1:D10").address(False, False) _
-            & """ .", vbCritical, TITLE
-            Cancel = True
-        End If
-    End If
-
-End Sub
-
-
-

VBA/build.frm

@@ -19,9 +19,6 @@ Public ship As String
 Public useval As Boolean
 Option Explicit
 
-
-
-
 Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
     Select Case KeyCode
         Case 13
@@ -67,14 +64,9 @@ Private Sub UserForm_Activate()
     cbBill.value = bill
     cbShip.value = ship
     
-    cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A2").CurrentRegion)
+    cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
-    'cbPart.list(1).Remove
+    cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
-    cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
+    cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
-    'cbPart.list(1).Remove
-    cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
-    'cbPart.list(1).Remove
-    
-
 End Sub
 
 

VBA/changes.frm

@@ -56,17 +56,12 @@ End Sub
 
 
 
-Private Sub tbPrint_Change()
-
-End Sub
-
-
 Private Sub UserForm_Activate()
 
     Dim fail As Boolean
     
     'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
-    x = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}}", fail)
+    x = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & shData.Cells(2, 5) & """}}", fail)
     If fail Then
         Me.Hide
         Exit Sub
@@ -86,8 +81,7 @@ Private Sub UserForm_Activate()
     lbHEAD.list(0, 4) = "Comment"
     lbHEAD.list(0, 5) = "Sales"
     lbHEAD.list(0, 6) = "id"
-    Dim tbo As New TheBigOne
+    Call Utils.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id")
-    Call tbo.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id")
     
     
     ' make it pretty
@@ -126,7 +120,7 @@ Sub delete_selected()
         End If
     Next i
     
-    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    shOrders.PivotTables("ptOrders").PivotCache.Refresh
     
     Me.lbHist.clear
     Me.Hide

VBA/fpvt.frm

@@ -129,10 +129,11 @@ End Sub
 Private Sub butMAdjust_Click()
 
     Dim i As Integer
-
+    Dim fail As Boolean
+    
     For i = 1 To 12
         If month(i, 10) <> "" Then
-            Call handler.request_adjust(CStr(month(i, 10)))
+            Call handler.request_adjust(CStr(month(i, 10)), fail)
         End If
     Next i
     
@@ -149,14 +150,14 @@ End Sub
 
 Private Sub cbGoSheet_Click()
 
-    Worksheets("month").tbMCOM.text = ""
+    shMonthView.tbMCOM.text = ""
-    Worksheets("month").sbMPV.value = 0
+    shMonthView.sbMPV.value = 0
-    Worksheets("month").sbMPP.value = 0
+    shMonthView.sbMPP.value = 0
     
     Me.Hide
-    months.cbMTAG.value = ""
+    shMonthView.cbMTAG.value = ""
-    Worksheets("month").Visible = xlSheetVisible
+    shMonthView.Visible = xlSheetVisible
-    Sheets("month").Select
+    shMonthView.Select
 
 End Sub
 
@@ -229,10 +230,10 @@ Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift
         End If
     Next i
     
-    vtable = x.ARRAYp_TransposeVar(vSwap)
+    vtable = Utils.ARRAYp_TransposeVar(vSwap)
-    vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
+    vtable = Utils.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
-    vtable = x.ARRAYp_TransposeVar(vtable)
+    vtable = Utils.ARRAYp_TransposeVar(vtable)
-    ptable = x.json_from_table_zb(vtable, "rows", True, False)
+    ptable = Utils.json_from_table_zb(vtable, "rows", True, False)
     Set jswap("swap") = JsonConverter.ParseJson(ptable)
     
     jswap("scenario")("version") = handler.plan
@@ -265,14 +266,14 @@ Private Sub dbGETSWAP_Click()
     lbSWAP.list = vSwap
     'Call x.frmListBoxHeader(lbSWAPH, lbSWAP, "Original", "Sales", "Replacement", "Fit")
     
-    cbPLIST.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
+    cbPLIST.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
     
     '---------build change-------------
     Set jswap = j
-    vtable = x.ARRAYp_TransposeVar(vSwap)
+    vtable = Utils.ARRAYp_TransposeVar(vSwap)
-    vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
+    vtable = Utils.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
-    vtable = x.ARRAYp_TransposeVar(vtable)
+    vtable = Utils.ARRAYp_TransposeVar(vtable)
-    ptable = x.json_from_table_zb(vtable, "rows", True, False)
+    ptable = Utils.json_from_table_zb(vtable, "rows", True, False)
     Set jswap("swap") = JsonConverter.ParseJson(ptable)
     
     jswap("scenario")("version") = handler.plan
@@ -464,10 +465,6 @@ Private Sub opPlugVol_Click()
     End If
 End Sub
 
-Private Sub pickSWAP_Change()
-
-End Sub
-
 Private Sub sbpd_Change()
 
     tbpd.value = sbpd.value
@@ -592,13 +589,13 @@ Private Sub UserForm_Activate()
     Dim ok As Boolean
     Dim tags() As Variant
     
-    Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2)
+    Me.Caption = "Forecast Adjust " & shConfig.Cells(8, 2)
     Me.mp.Visible = False
     
     Me.lheader = "Loading..."
 
     Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
-    Call x.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
+    Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
     
     Me.lheader = "Ready"
     
@@ -633,7 +630,7 @@ Private Sub UserForm_Activate()
     
     For i = 1 To sp("package")("totals").Count
         Select Case sp("package")("totals")(i)("order_season")
-            Case 2023
+            Case 2024
                 Select Case Me.iter_def(sp("package")("totals")(i)("iter"))
                     Case "baseline"
                         bVol = bVol + sp("package")("totals")(i)("units")
@@ -752,7 +749,7 @@ Private Sub UserForm_Activate()
         cust(i, 3) = ""
     Next i
     
-    Call x.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
+    Call Utils.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
     
     
     '-------------load tags-------------------------------
@@ -762,9 +759,9 @@ Private Sub UserForm_Activate()
             tags(i - 1, 0) = sp("package")("tags")(i)
         Next i
         cbTAG.list = tags
-        Sheets("month").cbMTAG.list = tags
+        shMonthView.cbMTAG.list = tags
         cbTAG.ListRows = UBound(tags, 1) + 1
-        months.cbMTAG.ListRows = UBound(tags, 1) + 1
+        shMonthView.cbMTAG.ListRows = UBound(tags, 1) + 1
     End If
     
     '----------reset spinner buttons----------------------
@@ -776,11 +773,11 @@ Private Sub UserForm_Activate()
     lbSWAP.clear
     pickSWAP.value = ""
     pickSWAP.text = Mid(sp("package")("basket")(1)("part_descr"), 1, 8)
-    pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F2").CurrentRegion)
+    pickSWAP.list = shSupportingData.ListObjects("MOLD").DataBodyRange.value
-    cbBT.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
+    cbBT.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
-    cbST.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
+    cbST.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
     lbCUST.list = cust
-    Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
+    Call Utils.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
     
     '---------price volume radio button colors----------
     If opPlugPrice.value = True Then
@@ -898,10 +895,10 @@ Sub build_cust_swap()
     Dim vtable() As Variant
     Dim ptable As String
     vtable = lbCUST.list
-    vtable = x.ARRAYp_TransposeVar(vtable)
+    vtable = Utils.ARRAYp_TransposeVar(vtable)
-    vtable = x.ARRAYp_zerobased_addheader(vtable, "bill", "bill_r", "ship", "ship_r")
+    vtable = Utils.ARRAYp_zerobased_addheader(vtable, "bill", "bill_r", "ship", "ship_r")
-    vtable = x.ARRAYp_TransposeVar(vtable)
+    vtable = Utils.ARRAYp_TransposeVar(vtable)
-    ptable = x.json_from_table_zb(vtable, "rows", True, False)
+    ptable = Utils.json_from_table_zb(vtable, "rows", True, False)
     Set cswap = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}")
     cswap("scenario")("version") = handler.plan
     cswap("scenario")("iter") = handler.basis
@@ -1357,12 +1354,3 @@ Function iter_def(ByVal iter As String) As String
     iter_def = "exclude"
 
 End Function
-
-Sub new_part()
-
-End Sub
-
-
-Private Sub UserForm_Initialize()
-
-End Sub

VBA/handler.bas

@@ -5,8 +5,6 @@ Public sql As String
 Public jsql As String
 Public scenario As String
 Public sc() As Variant
-Public x As New TheBigOne
-Public wapi As New Windows_API
 Public data() As String
 Public agg() As String
 Public showprice As Boolean
@@ -21,8 +19,6 @@ Sub load_fpvt()
 
     Application.StatusBar = "retrieving selection data....."
     
-    'data = x.SHTp_Get("data", 1, 1, True)
-    'Call x.TBLp_Aggregate(data, True, True, True, Array(1, 3), Array("S", "S"), Array(30))
     Dim i As Long
     Dim s_tot As Object
     
@@ -78,7 +74,6 @@ End Function
 Sub pg_main_workset(rep As String)
 
     Dim req As New WinHttp.WinHttpRequest
-    Dim wapi As New Windows_API
     Dim wr As String
     Dim json As Object
     Dim i As Long
@@ -181,8 +176,8 @@ Sub pg_main_workset(rep As String)
 
     ReDim str(UBound(res, 1), UBound(res, 2))
     
-    Worksheets("data").Cells.ClearContents
+    shData.Cells.ClearContents
-    Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
+    Call Utils.SHTp_DumpVar(res, shData.Name, 1, 1, False, True, True)
     
 
 End Sub
@@ -214,7 +209,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 = Sheets("config").Cells(1, 2)
+    server = shConfig.Cells(1, 2)
     
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
@@ -311,16 +306,16 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
 '    Next i
     
     i = 1
-    Do Until Sheets("data").Cells(i, 1) = ""
+    Do Until shData.Cells(i, 1) = ""
         i = i + 1
     Loop
     
-    Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
+    Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
     
     
-    'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
+    'Call Utils.SHTp_Dump(str, shData.Name, CLng(i), 1, False, False, 28, 29, 30, 31, 32)
     
-    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    shOrders.PivotTables("ptOrders").PivotCache.Refresh
     
 End Function
 
@@ -329,13 +324,13 @@ Sub load_config()
     Dim i As Integer
     Dim j As Integer
     '----server to use---------------------------------------------------------
-    handler.server = Sheets("config").Cells(1, 2)
+    handler.server = shConfig.Cells(1, 2)
     '---basis-----------------------------------------------------------------
     ReDim handler.basis(100)
     i = 2
     j = 0
-    Do While Sheets("config").Cells(2, i) <> ""
+    Do While shConfig.Cells(2, i) <> ""
-        handler.basis(j) = Sheets("config").Cells(2, i)
+        handler.basis(j) = shConfig.Cells(2, i)
         j = j + 1
         i = i + 1
     Loop
@@ -344,8 +339,8 @@ Sub load_config()
     ReDim handler.baseline(100)
     i = 2
     j = 0
-    Do While Sheets("config").Cells(3, i) <> ""
+    Do While shConfig.Cells(3, i) <> ""
-        handler.baseline(j) = Sheets("config").Cells(3, i)
+        handler.baseline(j) = shConfig.Cells(3, i)
         j = j + 1
         i = i + 1
     Loop
@@ -354,14 +349,14 @@ Sub load_config()
     ReDim handler.adjust(100)
     i = 2
     j = 0
-    Do While Sheets("config").Cells(4, i) <> ""
+    Do While shConfig.Cells(4, i) <> ""
-        handler.adjust(j) = Sheets("config").Cells(4, i)
+        handler.adjust(j) = shConfig.Cells(4, i)
         j = j + 1
         i = i + 1
     Loop
     ReDim Preserve handler.adjust(j - 1)
     '---plan version--------------------------------------------------------------
-    handler.plan = Sheets("config").Cells(9, 2)
+    handler.plan = shConfig.Cells(9, 2)
     
 End Sub
 
@@ -370,104 +365,105 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
     Dim j As Object
     Dim i As Integer
     Dim r As Long
-    Dim sh As Worksheet
-    Set sh = Sheets("_month")
     
-    Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
+    With shMonthUpdate
-    sh.Cells(1, 16) = JsonConverter.ConvertToJson(j)
     
-    For i = 0 To 12
+        Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
-        '------------volume-------------------
+        .Cells(1, 16) = JsonConverter.ConvertToJson(j)
-        sh.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
-        sh.Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
-        sh.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
-        sh.Cells(i + 1, 4) = 0
-        sh.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
         
-        '------------value----------------------
+        For i = 0 To 12
-        sh.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
+            '------------volume-------------------
-        sh.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
+            .Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
-        sh.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
+            .Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
-        sh.Cells(i + 1, 14) = 0
+            .Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
-        sh.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
+            .Cells(i + 1, 4) = 0
-        
+            .Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
-        '-------------price----------------------
-        If i > 0 Then
-            '--prior--
-            If co_num(pkg(i, 1), 0) = 0 Then
-                sh.Cells(i + 1, 6) = 0
-            Else
-                sh.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
-            End If
             
-            '--base--
+            '------------value----------------------
-            If co_num(pkg(i, 2), 0) = 0 Then
+            .Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
-                'if there is no monthly base volume,
+            .Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
-                'then use the prior price, if there was no prior price,
+            .Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
-                'then inherit the average price for the year before current adjustments
+            .Cells(i + 1, 14) = 0
-                If sh.Cells(i, 7) <> 0 Then
+            .Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
-                    sh.Cells(i + 1, 7) = sh.Cells(i, 7)
+            
+            '-------------price----------------------
+            If i > 0 Then
+                '--prior--
+                If co_num(pkg(i, 1), 0) = 0 Then
+                    .Cells(i + 1, 6) = 0
                 Else
-                    If pkg(13, 1) + pkg(13, 2) = 0 Then
+                    .Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
-                        sh.Cells(i + 1, 7) = 0
-                    Else
-                        sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
-                    End If
                 End If
-            Else
+                
-                sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
+                '--base--
-            End If
+                If co_num(pkg(i, 2), 0) = 0 Then
-            
+                    'if there is no monthly base volume,
-            '--adjust--
+                    'then use the prior price, if there was no prior price,
-            If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
+                    'then inherit the average price for the year before current adjustments
-                sh.Cells(i + 1, 8) = 0
+                    If .Cells(i, 7) <> 0 Then
-            Else
+                        .Cells(i + 1, 7) = .Cells(i, 7)
-                sh.Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
+                    Else
-            End If
+                        If pkg(13, 1) + pkg(13, 2) = 0 Then
-            
+                            .Cells(i + 1, 7) = 0
-            '--current adjust--
+                        Else
-            sh.Cells(i + 1, 9) = 0
+                            .Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
-            
+                        End If
-            '--forecast--
+                    End If
-            If co_num(pkg(i, 4), 0) = 0 Then
-                'if there is no monthly base volume,
-                'then use the prior price, if there was no prior price,
-                'then inherit the average price for the year before current adjustments
-                If sh.Cells(i, 10) <> 0 Then
-                    sh.Cells(i + 1, 10) = sh.Cells(i, 10)
                 Else
-                    If pkg(13, 1) + pkg(13, 2) = 0 Then
+                    .Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
-                        sh.Cells(i + 1, 10) = 0
-                    Else
-                        sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
-                    End If
                 End If
-            Else
+                
-                sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
+                '--adjust--
+                If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
+                    .Cells(i + 1, 8) = 0
+                Else
+                    .Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
+                End If
+                
+                '--current adjust--
+                .Cells(i + 1, 9) = 0
+                
+                '--forecast--
+                If co_num(pkg(i, 4), 0) = 0 Then
+                    'if there is no monthly base volume,
+                    'then use the prior price, if there was no prior price,
+                    'then inherit the average price for the year before current adjustments
+                    If .Cells(i, 10) <> 0 Then
+                        .Cells(i + 1, 10) = .Cells(i, 10)
+                    Else
+                        If pkg(13, 1) + pkg(13, 2) = 0 Then
+                            .Cells(i + 1, 10) = 0
+                        Else
+                            .Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
+                        End If
+                    End If
+                Else
+                    .Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
+                End If
+                
             End If
             
-        End If
+        Next i
         
-    Next i
+        'scenario
-    
+        .Range("R1:S1000").ClearContents
-    'scenario
+        For i = 0 To UBound(handler.sc, 1)
-    Sheets("_month").Range("R1:S1000").ClearContents
+            .Cells(i + 1, 18) = handler.sc(i, 0)
-    For i = 0 To UBound(handler.sc, 1)
+            .Cells(i + 1, 19) = handler.sc(i, 1)
-        sh.Cells(i + 1, 18) = handler.sc(i, 0)
+        Next i
-        sh.Cells(i + 1, 19) = handler.sc(i, 1)
+        
-    Next i
+        'basket
-    
+        .Range("U1:AC100000").ClearContents
-    'basket
+        Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True)
-    sh.Range("U1:AC100000").ClearContents
+        Call Utils.SHTp_DumpVar(basket, .Name, 1, 26, False, False, True)
-    Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
+        shConfig.Cells(5, 2) = 0
-    Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
+        shConfig.Cells(6, 2) = 0
-    Sheets("config").Cells(5, 2) = 0
+        shConfig.Cells(7, 2) = 0
-    Sheets("config").Cells(6, 2) = 0
+        
-    Sheets("config").Cells(7, 2) = 0
+        shMonthView.load_sheet
-    
-    months.load_sheet
-    
     
+    End With
+        
 End Sub
 
 Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
@@ -495,7 +491,7 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
         Exit Function
     End If
     
-    server = Sheets("config").Cells(1, 2)
+    server = shConfig.Cells(1, 2)
     
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
@@ -559,12 +555,10 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
     logid = json("x")(1)("id")
     
     '---------loop through and get a list of each row that needs deleted?-----
-    
+       
-    Set ds = Sheets("data")
-    
     j = 0
     For i = 1 To 100
-        If ds.Cells(1, i) = "logid" Then
+        If shData.Cells(1, i) = "logid" Then
             j = i
             Exit For
         End If
@@ -577,15 +571,15 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
     End If
     
     i = 2
-    While ds.Cells(i, 1) <> ""
+    With shData
-        If ds.Cells(i, j) = logid Then
+        While .Cells(i, 1) <> ""
-            ds.Rows(i).Delete
+            If .Cells(i, j) = logid Then
-        Else
+                .Rows(i).Delete
-            i = i + 1
+            Else
-        End If
+                i = i + 1
-    Wend
+            End If
-    
+        Wend
-    
+    End With
 
 End Function
 
@@ -610,7 +604,7 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
         Exit Function
     End If
     
-    server = Sheets("config").Cells(1, 2)
+    server = shConfig.Cells(1, 2)
     
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All

VBA/openf.frm

@@ -25,7 +25,7 @@ Private Sub cbOK_Click()
 
     openf.Caption = "retrieving data......"
     Call handler.pg_main_workset(cbDSM.value)
-    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    shOrders.PivotTables("ptOrders").PivotCache.Refresh
     Application.StatusBar = False
     openf.Hide
 
@@ -34,18 +34,10 @@ End Sub
 Private Sub UserForm_Activate()
 
     'handler.server = "http://192.168.1.69:3000"
-    handler.server = Sheets("config").Cells(1, 2)
+    handler.server = shConfig.Cells(1, 2)
-
-    Dim x As New TheBigOne
-    Dim d() As String
     
     openf.Caption = "Select a DSM"
-    d = x.SHTp_Get("reps", 1, 1, True)
+    cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value
-    
-    For i = 1 To UBound(d, 2)
-        Call cbDSM.AddItem(d(0, i))
-    Next i
-
 
 End Sub
 

VBA/part.frm

@@ -39,9 +39,7 @@ End Sub
 Private Sub UserForm_Activate()
     
     useval = False
-    
+    cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
-    cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
-    
 
 End Sub
 

VBA/shConfig.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shConfig"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

VBA/shData.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shData"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

VBA/shMonthUpdate.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shMonthUpdate"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

VBA/shMonthView.cls

@@ -2,14 +2,13 @@ VERSION 1.0 CLASS
 BEGIN
   MultiUse = -1  'True
 END
-Attribute VB_Name = "months"
+Attribute VB_Name = "shMonthView"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = True
 Option Explicit
 
-Private x As New TheBigOne
 Private units() As Variant
 Private price() As Variant
 Private sales() As Variant
@@ -31,13 +30,6 @@ Private b() As Variant 'holds basket
 Private did_load_config As Boolean
 
 
-
-Private Sub cbMTAG_Change()
-
-    
-
-End Sub
-
 Private Sub sbMPP_Change()
     Dim m As Worksheet
     Dim i As Long
@@ -46,7 +38,7 @@ Private Sub sbMPP_Change()
     
     dumping = True
     
-    Set m = Sheets("month")
+    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)
@@ -68,7 +60,7 @@ Private Sub sbMPV_Change()
     
     dumping = True
     
-    Set m = Sheets("month")
+    Set m = shMonthView
     m.Cells(19, 5) = sbMPV.value / 100
     For i = 6 To 17
         If m.Cells(i, 5) <> "" Then
@@ -117,7 +109,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
         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 Worksheets("config").Cells(6, 2) = 1 Then
+        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
@@ -129,7 +121,7 @@ End Sub
 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
+    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
@@ -140,7 +132,7 @@ End Sub
 
 Sub picker_shortcut()
     
-    If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 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
 
@@ -148,7 +140,7 @@ End Sub
 
 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
+    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
@@ -228,7 +220,7 @@ On Error GoTo errh
     Dim i As Integer
     Call Me.get_sheet
     Dim vp As String
-    vp = Sheets("month").Range("Q2")
+    vp = shMonthView.Range("Q2")
 
     For i = 1 To 12
         If sales(i, 5) = "" Then sales(i, 5) = 0
@@ -284,7 +276,7 @@ Sub ms_adj()
     Dim i As Integer
     Call Me.get_sheet
     Dim vp As String
-    vp = Sheets("month").Range("Q2")
+    vp = shMonthView.Range("Q2")
 
     For i = 1 To 12
         If sales(i, 4) = "" Then sales(i, 4) = 0
@@ -344,7 +336,7 @@ Sub get_sheet()
     tprice = Range("H18:L18")
     tsales = Range("N18:R18")
     ReDim adjust(12)
-    Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
+    Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
       
 End Sub
 
@@ -361,15 +353,15 @@ 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 Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("R1")), shMonthView.Name, 6, 20, False, False, False)
-    'Sheets("month").Range("B32:Q5000").ClearContents
+    'shMonthView.Range("B32:Q5000").ClearContents
     
     If Me.newpart Then
-        Sheets("_month").Range("P2:P13").ClearContents
+        shMonthUpdate.Range("P2:P13").ClearContents
-        Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
+        shMonthUpdate.Cells(2, 16) = JsonConverter.ConvertToJson(np)
     Else
         For i = 1 To 12
-            Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
+            shMonthUpdate.Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
         Next i
     End If
     
@@ -379,16 +371,16 @@ End Sub
 
 Sub load_sheet()
 
-    units = Sheets("_month").Range("A2:E13").FormulaR1C1
+    units = shMonthUpdate.Range("A2:E13").FormulaR1C1
-    price = Sheets("_month").Range("F2:J13").FormulaR1C1
+    price = shMonthUpdate.Range("F2:J13").FormulaR1C1
-    sales = Sheets("_month").Range("K2:O13").FormulaR1C1
+    sales = shMonthUpdate.Range("K2:O13").FormulaR1C1
-    scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
+    scenario = shMonthUpdate.Range("R1:S13").FormulaR1C1
     tunits = Range("B18:F18")
     tprice = Range("H18:L18")
     tsales = Range("N18:R18")
     'reset basket
-    Sheets("_month").Range("U1:X10000").ClearContents
+    shMonthUpdate.Range("U1:X10000").ClearContents
-    Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
+    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
@@ -410,17 +402,17 @@ Sub set_format()
     Dim val_adj As Range
     Dim val_set As Range
     
-    Set prices = Sheets("month").Range("H6:L17")
+    Set prices = shMonthView.Range("H6:L17")
-    Set price_adj = Sheets("month").Range("K6:K17")
+    Set price_adj = shMonthView.Range("K6:K17")
-    Set price_set = Sheets("month").Range("L6:L17")
+    Set price_set = shMonthView.Range("L6:L17")
     
-    Set vol = Sheets("month").Range("B6:F17")
+    Set vol = shMonthView.Range("B6:F17")
-    Set vol_adj = Sheets("month").Range("E6:E17")
+    Set vol_adj = shMonthView.Range("E6:E17")
-    Set vol_set = Sheets("month").Range("F6:F17")
+    Set vol_set = shMonthView.Range("F6:F17")
     
-    Set val = Sheets("month").Range("N6:R17")
+    Set val = shMonthView.Range("N6:R17")
-    Set val_adj = Sheets("month").Range("Q6:Q17")
+    Set val_adj = shMonthView.Range("Q6:Q17")
-    Set val_set = Sheets("month").Range("R6:R17")
+    Set val_set = shMonthView.Range("R6:R17")
     
     Call Me.format_price(prices)
     Call Me.set_border(prices)
@@ -541,8 +533,8 @@ Sub build_json()
     ReDim handler.basis(100)
     i = 2
     j = 0
-    Do While Sheets("config").Cells(2, i) <> ""
+    Do While shConfig.Cells(2, i) <> ""
-        handler.basis(j) = Sheets("config").Cells(2, i)
+        handler.basis(j) = shConfig.Cells(2, i)
         j = j + 1
         i = i + 1
     Loop
@@ -568,7 +560,7 @@ Sub build_json()
                 Set o = JsonConverter.ParseJson("{}")
                 o("amount") = sales(pos, 5)
                 o("qty") = units(pos, 5)
-                Set m(Worksheets("month").Cells(5 + pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
+                Set m(shMonthView.Cells(5 + pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
             End If
         Else
             'if something is changing
@@ -585,7 +577,7 @@ Sub build_json()
                         '--ignore above comment and always use add month_vp
                         adjust(pos)("type") = "addmonth_vp"
                     End If
-                    adjust(pos)("month") = Worksheets("month").Cells(5 + pos, 1)
+                    adjust(pos)("month") = shMonthView.Cells(5 + pos, 1)
                     adjust(pos)("qty") = units(pos, 4)
                     adjust(pos)("amount") = sales(pos, 4)
                 Else
@@ -603,7 +595,7 @@ Sub build_json()
                     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") = Worksheets("month").Cells(5 + pos, 1)
+                    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
@@ -616,24 +608,24 @@ Sub build_json()
     
     If Me.newpart Then
         Set np("months") = JsonConverter.ParseJson(JsonConverter.ConvertToJson(m))
-        np("newpart") = Worksheets("month").Range("B33").value
+        np("newpart") = shMonthView.Range("B33").value
         'np("basket") = x.json_from_table(b, "basket", False)
         'get the basket from the sheet
-        b = Worksheets("_month").Range("U1").CurrentRegion.value
+        b = shMonthUpdate.Range("U1").CurrentRegion.value
-        Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
+        Set m = JsonConverter.ParseJson(Utils.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("[" & Utils.json_from_table(b, "basket", False) & "]")
         Else
             Set np("basket") = m("basket")
         End If
     End If
     
     If Me.newpart Then
-        Sheets("_month").Range("P2:P13").ClearContents
+        shMonthUpdate.Range("P2:P13").ClearContents
-        Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
+        shMonthUpdate.Cells(2, 16) = JsonConverter.ConvertToJson(np)
     Else
         For i = 1 To 12
-            Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
+            shMonthUpdate.Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
         Next i
     End If
 
@@ -689,12 +681,11 @@ End Sub
 
 Sub Cancel()
 
-    Sheets("Orders").Select
+    shOrders.Select
 
 End Sub
 
 Sub reset()
-
     
     Call Me.load_sheet
     
@@ -703,10 +694,10 @@ End Sub
 Sub switch_basket()
 
 
-    If Sheets("config").Cells(6, 2) = 1 Then
+    If shConfig.Cells(6, 2) = 1 Then
-        Sheets("config").Cells(6, 2) = 0
+        shConfig.Cells(6, 2) = 0
     Else
-        Sheets("config").Cells(6, 2) = 1
+        shConfig.Cells(6, 2) = 1
     End If
     
     Call Me.print_basket
@@ -716,10 +707,10 @@ End Sub
 
 Sub print_basket()
 
-    'Sheets("config").Cells(6, 2) = 1
+    'SHCONFIG.Cells(6, 2) = 1
-    If Sheets("config").Cells(6, 2) = 0 Then
+    If shConfig.Cells(6, 2) = 0 Then
         dumping = True
-        Worksheets("month").Range("B32:Q10000").ClearContents
+        shMonthView.Range("B32:Q10000").ClearContents
         Rows("20:31").Hidden = False
         dumping = False
         Exit Sub
@@ -727,16 +718,16 @@ Sub print_basket()
 
     Dim i As Long
     Dim basket() As Variant
-    basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
+    basket = Utils.SHTp_get_block(shMonthUpdate.Range("U1"))
     
     dumping = True
     
-    Worksheets("month").Range("B32:Q10000").ClearContents
+    shMonthView.Range("B32:Q10000").ClearContents
     For i = 1 To UBound(basket, 1)
-        Sheets("month").Cells(31 + i, 2) = basket(i, 1)
+        shMonthView.Cells(31 + i, 2) = basket(i, 1)
-        Sheets("month").Cells(31 + i, 6) = basket(i, 2)
+        shMonthView.Cells(31 + i, 6) = basket(i, 2)
-        Sheets("month").Cells(31 + i, 12) = basket(i, 3)
+        shMonthView.Cells(31 + i, 12) = basket(i, 3)
-        Sheets("month").Cells(31 + i, 17) = basket(i, 4)
+        shMonthView.Cells(31 + i, 17) = basket(i, 4)
     Next i
     
     Rows("21:31").Hidden = True
@@ -751,26 +742,26 @@ Sub basket_pick(ByRef Target As Range)
         Dim i As Long
         
 
-        build.part = Sheets("month").Cells(Target.row, 2)
+        build.part = shMonthView.Cells(Target.row, 2)
-        build.bill = rev_cust(Sheets("month").Cells(Target.row, 6))
+        build.bill = rev_cust(shMonthView.Cells(Target.row, 6))
-        build.ship = rev_cust(Sheets("month").Cells(Target.row, 12))
+        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 Sheets("month").Cells(Target.row, 2) = "" Then
+            If shMonthView.Cells(Target.row, 2) = "" Then
-                Do Until Sheets("month").Cells(Target.row + i, 2) <> ""
+                Do Until shMonthView.Cells(Target.row + i, 2) <> ""
                     i = i - 1
                 Loop
                 i = i + 1
             End If
             
             
-            Sheets("month").Cells(Target.row + i, 2) = build.cbPart.value
+            shMonthView.Cells(Target.row + i, 2) = build.cbPart.value
-            Sheets("month").Cells(Target.row + i, 6) = rev_cust(build.cbBill.value)
+            shMonthView.Cells(Target.row + i, 6) = rev_cust(build.cbBill.value)
-            Sheets("month").Cells(Target.row + i, 12) = rev_cust(build.cbShip.value)
+            shMonthView.Cells(Target.row + i, 12) = rev_cust(build.cbShip.value)
             dumping = False
             Set basket_touch = Selection
             Call Me.get_edit_basket
@@ -793,7 +784,7 @@ Sub get_edit_basket()
     'ReDim b(basket_rows, 3)
     
     i = 0
-    Do Until Worksheets("month").Cells(33 + i, 2) = ""
+    Do Until shMonthView.Cells(33 + i, 2) = ""
         i = i + 1
     Loop
     i = i - 1
@@ -804,14 +795,14 @@ Sub get_edit_basket()
     
     i = 0
     mix = 0
-    Do Until Worksheets("month").Cells(33 + i, 2) = ""
+    Do Until shMonthView.Cells(33 + i, 2) = ""
-        b(i, 0) = Worksheets("month").Cells(33 + i, 2)
+        b(i, 0) = shMonthView.Cells(33 + i, 2)
-        b(i, 1) = Worksheets("month").Cells(33 + i, 6)
+        b(i, 1) = shMonthView.Cells(33 + i, 6)
-        b(i, 2) = Worksheets("month").Cells(33 + i, 12)
+        b(i, 2) = shMonthView.Cells(33 + i, 12)
-        b(i, 3) = Worksheets("month").Cells(33 + i, 17)
+        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, Worksheets("month").Cells(33 + i, 17)) Is Nothing Then
+        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
@@ -834,13 +825,13 @@ Sub get_edit_basket()
     
     'put the mix plug back on the the sheet
     For i = 0 To UBound(b, 1)
-        Worksheets("month").Cells(33 + i, 17) = b(i, 3)
+        shMonthView.Cells(33 + i, 17) = b(i, 3)
     Next i
     
     dumping = False
     
-    Worksheets("_month").Range("U2:X5000").ClearContents
+    shMonthUpdate.Range("U2:X5000").ClearContents
-    Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
+    Call Utils.SHTp_DumpVar(b, shMonthUpdate.Name, 2, 21, False, False, True)
     
     If Me.newpart Then
         Me.build_json
@@ -860,7 +851,7 @@ Sub post_adjust()
     Dim jdoc As String
     
     If Me.newpart Then
-        Set adjust = JsonConverter.ParseJson(Sheets("_month").Cells(2, 16))
+        Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(2, 16))
         adjust("message") = Me.tbMCOM.text
         adjust("tag") = Me.cbMTAG.text
         jdoc = JsonConverter.ConvertToJson(adjust)
@@ -868,8 +859,8 @@ Sub post_adjust()
         If fail Then Exit Sub
     Else
         For i = 2 To 13
-            If Sheets("_month").Cells(i, 16) <> "" Then
+            If shMonthUpdate.Cells(i, 16) <> "" Then
-                Set adjust = JsonConverter.ParseJson(Sheets("_month").Cells(i, 16))
+                Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(i, 16))
                 adjust("message") = Me.tbMCOM.text
                 adjust("tag") = Me.cbMTAG.text
                 jdoc = JsonConverter.ConvertToJson(adjust)
@@ -879,14 +870,14 @@ Sub post_adjust()
         Next i
     End If
     
-    Sheets("Orders").Select
+    shOrders.Select
-    'Worksheets("month").Visible = xlHidden
+    'shMonthView.Visible = xlHidden
 
 End Sub
 
 Sub build_new()
 
-    Worksheets("config").Cells(5, 2) = 1
+    shConfig.Cells(5, 2) = 1
     Dim i As Long
     Dim j As Long
     Dim basket() As Variant
@@ -894,7 +885,7 @@ Sub build_new()
 
     dumping = True
     
-    m = Sheets("_month").Range("A2:O13").FormulaR1C1
+    m = shMonthUpdate.Range("A2:O13").FormulaR1C1
     
     For i = 1 To UBound(m, 1)
         For j = 1 To UBound(m, 2)
@@ -902,20 +893,18 @@ Sub build_new()
         Next j
     Next i
     
-    Worksheets("_month").Range("A2:O13") = m
+    shMonthUpdate.Range("A2:O13") = m
     
-    Worksheets("_month").Range("U2:X1000").ClearContents
+    shMonthUpdate.Range("U2:X1000").ClearContents
-    Worksheets("_month").Range("Z2:AC1000").ClearContents
+    shMonthUpdate.Range("Z2:AC1000").ClearContents
-    Worksheets("_month").Range("R2:S1000").ClearContents
+    shMonthUpdate.Range("R2:S1000").ClearContents
     Call Me.load_sheet
-    '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 = Utils.SHTp_get_block(shMonthUpdate.Range("U1"))
-    Sheets("month").Cells(32, 2) = basket(1, 1)
+    shMonthView.Cells(32, 2) = basket(1, 1)
-    Sheets("month").Cells(32, 6) = basket(1, 2)
+    shMonthView.Cells(32, 6) = basket(1, 2)
-    Sheets("month").Cells(32, 12) = basket(1, 3)
+    shMonthView.Cells(32, 12) = basket(1, 3)
-    Sheets("month").Cells(32, 17) = basket(1, 4)
+    shMonthView.Cells(32, 17) = basket(1, 4)
     Call Me.print_basket
 
     dumping = False
@@ -934,8 +923,8 @@ Sub new_part()
     
     '---------build customer mix-------------------------------------------------------------------
     
-    cust = x.SHTp_Get("_month", 1, 27, True)
+    cust = Utils.SHTp_Get(shMonthUpdate.Name, 1, 27, True)
-    If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
+    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
     
@@ -949,49 +938,49 @@ Sub new_part()
     
     dumping = True
     
-    Worksheets("month").Range("B33:Q10000").ClearContents
+    shMonthView.Range("B33:Q10000").ClearContents
     
     For i = 1 To UBound(cust, 2)
-        Sheets("month").Cells(32 + i, 2) = part.cbPart.value
+        shMonthView.Cells(32 + i, 2) = part.cbPart.value
-        Sheets("month").Cells(32 + i, 6) = cust(0, i)
+        shMonthView.Cells(32 + i, 6) = cust(0, i)
-        Sheets("month").Cells(32 + i, 12) = cust(1, i)
+        shMonthView.Cells(32 + i, 12) = cust(1, i)
-        Sheets("month").Cells(32 + i, 17) = CDbl(cust(2, i))
+        shMonthView.Cells(32 + i, 17) = CDbl(cust(2, i))
     Next i
     
-    Sheets("config").Cells(7, 2) = 1
+    shConfig.Cells(7, 2) = 1
     
     '------copy revised basket to _month storage---------------------------------------------------
     
     i = 0
-    Do Until Worksheets("month").Cells(33 + i, 2) = ""
+    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 Worksheets("month").Cells(33 + i, 2) = ""
+    Do Until shMonthView.Cells(33 + i, 2) = ""
-        b(i, 0) = Worksheets("month").Cells(33 + i, 2)
+        b(i, 0) = shMonthView.Cells(33 + i, 2)
-        b(i, 1) = Worksheets("month").Cells(33 + i, 6)
+        b(i, 1) = shMonthView.Cells(33 + i, 6)
-        b(i, 2) = Worksheets("month").Cells(33 + i, 12)
+        b(i, 2) = shMonthView.Cells(33 + i, 12)
-        b(i, 3) = Worksheets("month").Cells(33 + i, 17)
+        b(i, 3) = shMonthView.Cells(33 + i, 17)
         If b(i, 3) = "" Then b(i, 3) = 0
         i = i + 1
     Loop
-    Worksheets("_month").Range("U2:AC10000").ClearContents
+    shMonthUpdate.Range("U2:AC10000").ClearContents
-    Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
+    Call Utils.SHTp_DumpVar(b, shMonthUpdate.Name, 2, 21, False, False, True)
-    Call x.SHTp_DumpVar(b, "_month", 2, 26, 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 = Sheets("_month").Range("A2:E13").FormulaR1C1
+    units = shMonthUpdate.Range("A2:E13").FormulaR1C1
-    price = Sheets("_month").Range("F2:J13").FormulaR1C1
+    price = shMonthUpdate.Range("F2:J13").FormulaR1C1
-    sales = Sheets("_month").Range("K2:O13").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(Sheets("_month").Range("P1").FormulaR1C1)
+    Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
     For i = 1 To 12
         'volume
         units(i, 5) = units(i, 2)
@@ -1018,13 +1007,13 @@ Sub new_part()
     
     '-------------push revised arrays back to _month, not revertable-------------------------------
     
-    Worksheets("_month").Range("A2:E13") = units
+    shMonthUpdate.Range("A2:E13") = units
-    Worksheets("_month").Range("F2:J13") = price
+    shMonthUpdate.Range("F2:J13") = price
-    Worksheets("_month").Range("K2:o13") = sales
+    shMonthUpdate.Range("K2:o13") = sales
     
     
     'force basket to show to demonstrate the part was changed
-    Sheets("config").Cells(6, 2) = 1
+    shConfig.Cells(6, 2) = 1
     Call Me.print_basket
     dumping = False
     
@@ -1032,7 +1021,7 @@ End Sub
 
 Function newpart() As Boolean
 
-    If Worksheets("config").Cells(7, 2) = 1 Then
+    If shConfig.Cells(7, 2) = 1 Then
         newpart = True
     Else
         newpart = False

VBA/shOrders.cls

@@ -2,26 +2,23 @@ VERSION 1.0 CLASS
 BEGIN
   MultiUse = -1  'True
 END
-Attribute VB_Name = "pivot"
+Attribute VB_Name = "shOrders"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = True
 Option Explicit
 
-Private Sub Worksheet_Activate()
-
-End Sub
-
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-
+    Dim pt As PivotTable
-    If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
+    Set pt = ActiveSheet.PivotTables("ptOrders")
+    
+    Dim intersec As Range
+    Set intersec = Intersect(Target, pt.DataBodyRange)
+    
+    If intersec Is Nothing Then
         Exit Sub
-    End If
+    ElseIf intersec.address <> Target.address Then
-
-    On Error GoTo nopiv
-
-    If Target.Cells.PivotTable Is Nothing Then
         Exit Sub
     End If
 
@@ -38,10 +35,8 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
     Dim cd As Object
     Dim dd As Object
     
-    Dim pt As PivotTable
     Dim pf As PivotField
     Dim pi As PivotItem
-    Dim wapi As New Windows_API
     
     Set ri = Target.Cells.PivotCell.RowItems
     Set ci = Target.Cells.PivotCell.ColumnItems
@@ -51,7 +46,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
     Set cd = Target.Cells.PivotTable.ColumnFields
     
     ReDim handler.sc(ri.Count, 1)
-    Set pt = Target.Cells.PivotCell.PivotTable
     
     handler.sql = ""
     handler.jsql = ""
@@ -69,8 +63,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
     
     Call handler.load_config
     Call handler.load_fpvt
-    
-nopiv:
 
 End Sub
 

VBA/shSupportingData.cls

@@ -0,0 +1,9 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "shSupportingData"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = True

VBA/shWalk.cls

@@ -2,26 +2,22 @@ VERSION 1.0 CLASS
 BEGIN
   MultiUse = -1  'True
 END
-Attribute VB_Name = "pivot1"
+Attribute VB_Name = "shWalk"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = True
 Option Explicit
 
-Private Sub Worksheet_Activate()
-
-End Sub
-
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
-
+    Dim pt As PivotTable
-    If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
+    Set pt = ActiveSheet.PivotTables("ptWalk")
+    Dim intersec As Range
+    Set intersec = Intersect(Target, pt.DataBodyRange)
+    
+    If intersec Is Nothing Then
         Exit Sub
-    End If
+    ElseIf intersec.address <> Target.address Then
-
-    On Error GoTo nopiv
-
-    If Target.Cells.PivotTable Is Nothing Then
         Exit Sub
     End If
 
@@ -38,10 +34,8 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
     Dim cd As Object
     Dim dd As Object
     
-    Dim pt As PivotTable
     Dim pf As PivotField
     Dim pi As PivotItem
-    Dim wapi As New Windows_API
     
     Set ri = Target.Cells.PivotCell.RowItems
     Set ci = Target.Cells.PivotCell.ColumnItems
@@ -51,7 +45,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
     Set cd = Target.Cells.PivotTable.ColumnFields
     
     ReDim handler.sc(ri.Count, 1)
-    Set pt = Target.Cells.PivotCell.PivotTable
     
     handler.sql = ""
     handler.jsql = ""
@@ -69,8 +62,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
     
     Call handler.load_config
     Call handler.load_fpvt
-    
-nopiv:
 
 End Sub
 

build/build_forecast.sql

@@ -122,7 +122,7 @@ baseline AS (
         -----when null, greatest/least is just going to act like coalesce
         ,greatest(least(o.sdate,gld.edat),gld.sdat) sdate
         ,ss.ssyr sseas
-        ,'b23' "version"
+        ,'b24' "version"
         ,'actuals' iter
     FROM
         rlarp.osm o
@@ -135,11 +135,12 @@ baseline AS (
     WHERE
         (
             --base period orders booked....
-            o.odate BETWEEN '2022-06-01' AND '2023-03-01'
+            o.odate BETWEEN '2018-06-01' AND '2019-05-31'
             --...or any open orders currently booked before cutoff....
-            OR (o.calc_status IN ('OPEN','BACKORDER') and o.odate < '2023-03-01')
+            --OR (o.calc_status IN ('OPEN','BACKORDER') and o.odate < '2023-03-01')
             --...or anything that shipped in that period
-            OR ((o.fspr BETWEEN '2301' AND '2309' OR o.fspr = '0000') AND o.sdate < '2023-03-01')
+            --OR ((o.fspr BETWEEN '1901' AND '1912' OR o.fspr = '0000') AND o.sdate < '2023-03-01')
+            OR (o.fspr BETWEEN '1901' AND '1912') 
         )
         AND fs_line = '41010'
         AND calc_status <> 'CANCELED'
@@ -272,15 +273,15 @@ baseline AS (
         ,o.calc_status
         ,o.flag
         ,o.odate + interval '1 year' odate
-        ,o.oseas + 1 rseas
+        ,o.oseas + 5 rseas
         ,o.rdate + interval '1 year' rdate
-        ,o.rseas + 1 rseas
+        ,o.rseas + 5 rseas
         ,o.pdate + interval '1 year' pdate
-        ,o.pseas + 1 pseas
+        ,o.pseas + 5 pseas
         -----when null, greatest/least is just going to act like coalesce
         ,greatest(least(o.sdate,gld.edat),gld.sdat)  + interval '1 year' sdate
         ,ss.ssyr  sseas
-        ,'b23' "version"
+        ,'b24' "version"
         ,'actuals_plug' iter
     FROM
         rlarp.osm o
@@ -289,15 +290,16 @@ baseline AS (
         LEFT OUTER JOIN rlarp.gld ss ON
             greatest(least(o.sdate,gld.edat),gld.sdat) + interval '1 year' BETWEEN ss.sdat AND ss.edat
     WHERE
-        o.odate BETWEEN '2022-03-01' AND '2022-05-31'
+        false
-        AND fs_line = '41010'
+        --o.odate BETWEEN '2022-03-01' AND '2022-05-31'
-        AND calc_status <> 'CANCELED'
+        --AND fs_line = '41010'
-        AND NOT (calc_status = 'CLOSED' AND flag = 'REMAINDER')
+        --AND calc_status <> 'CANCELED'
-        --OR (
+        --AND NOT (calc_status = 'CLOSED' AND flag = 'REMAINDER')
-        --    (o.fspr BETWEEN '2209' AND '2212' OR o.fspr = '0000') 
+        ----OR (
-        --    AND o.sdate BETWEEN '2022-03-01' AND '2022-05-31'
+        ----    (o.fspr BETWEEN '2209' AND '2212' OR o.fspr = '0000') 
-        --)
+        ----    AND o.sdate BETWEEN '2022-03-01' AND '2022-05-31'
-        AND version = 'ACTUALS'
+        ----)
+        --AND version = 'ACTUALS'
     GROUP BY
         o.fspr
         ,plnt
@@ -432,7 +434,7 @@ baseline AS (
         -----when null, greatest/least is just going to act like coalesce
         ,greatest(least(o.sdate,gld.edat),gld.sdat) sdate
         ,ss.ssyr  sseas
-        ,'b23' "version"
+        ,'b24' "version"
         ,'forecast_plug' iter
     FROM
         rlarp.osmp o
@@ -479,11 +481,11 @@ SELECT
     ,o."dilin#"
     ,o.quoten
     ,o.quotel
-    ,o.dcodat + interval '1 year'   --incremented
+    ,o.dcodat + interval '5 years'   --incremented
-    ,o.ddqdat + interval '1 year'   --incremented
+    ,o.ddqdat + interval '5 years'   --incremented
     ,o.dcmdat
     ,o.fesdat
-    ,o.dhidat + interval '1 year'   --incremented
+    ,o.dhidat + interval '5 years'   --incremented
     ,o.fesind
     ,o.dhpost
     ,gld.fspr                       --incremented
@@ -567,22 +569,23 @@ SELECT
     ,o.fb_cst_loc_fut
     ,o.calc_status
     ,o.flag
-    ,o.odate + interval '1 year'    --incremented
+    ,o.odate + interval '5 years'    --incremented
-    ,o.oseas + 1                    --incremented
+    ,o.oseas + 5                    --incremented
-    ,o.rdate + interval '1 year'    --incremented
+    ,o.rdate + interval '5 years'    --incremented
-    ,o.rseas + 1                    --incremented
+    ,o.rseas + 5                    --incremented
-    ,o.pdate + interval '1 year'    --incremented
+    ,o.pdate + interval '5 years'    --incremented
-    ,o.pseas + 1                    --incremented
+    ,o.pseas + 5                    --incremented
-    ,o.sdate + interval '1 year'    --incremented
+    ,o.sdate + interval '5 years'    --incremented
-    ,o.sseas + 1                    --incremented
+    ,o.sseas + 5                    --incremented
-    ,'b23' "version"
+    ,'b24' "version"
     ,'copy' iter
 FROM
     baseline o
     LEFT OUTER JOIN rlarp.gld ON
-        (o.sdate + interval '1 year') BETWEEN gld.sdat and gld.edat
+        (o.sdate + interval '5 years') BETWEEN gld.sdat and gld.edat
 WHERE
-    o.odate + interval '1 year' >= '2023-06-01'
+    true
+    --o.odate + interval '5 years' >= '2023-06-01'
 )
 --INSERT INTO rlarp.osmf
 SELECT

build/convert_pool_all.sql

@@ -127,7 +127,8 @@ SELECT
 FROM
     rlarp.osm_pool
 WHERE
-    version <> 'actuals';
+    true;
+    --substring(iter,1,7) <> 'actuals';
 
 -------need to set item master values before other things-----------
 UPDATE

build/rebuild_script.sh

@@ -1,7 +1,9 @@
 #!/bin/bash
 #$PG -f ./build_stage.sql;
 #$PG -f ./build_rolling.sql;
-$PG -f ./snap_itemm.sql;
+$PG -f ./build/build_forecast.sql
-$PG -f ./snap_cost_current.sql;
+$PG -f ./build/snap_itemm.sql;
-$PG -f ./snap_customer.sql;
+$PG -f ./build/snap_cost_current.sql;
-$PG -f ./build_pool.sql;
+$PG -f ./build/snap_customer.sql;
+$PG -f ./build/build_pool.sql;
+$PG -c "CALL rlarp.convert_pool_all();"

inquirey/osmf_months.sql

@@ -1,15 +1,16 @@
 SELECT
     --o.glec
     to_char(CASE WHEN extract(month FROM o.odate) >= 6 THEN -5 ELSE 7 END + extract(month FROM o.odate),'FM00')||' - '||to_char(o.odate,'TMMon') order_month
-    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2023 AND iter = 'actuals'),0)         act2023
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2019 AND iter = 'actuals'),0)         act2019
-    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2023 AND iter = 'actuals_plug'),0)    act2023_plug
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2019 AND iter = 'actuals_plug'),0)    act2019_plug
-    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2023 AND version IN ('actuals','15mo')),0)    total_baseline
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2019 ),0)                             total_baseline
-    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2024 AND version = 'b23'),0)          plan2024
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2024 AND version = 'b24'),0)          plan2024
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2024 ),0)                             full2024
 FROM
     rlarp.osmf o
 WHERE
-    oseas IN (2023,2024)
+    --oseas IN (2023,2024)
-    AND substring(glec,1,1) <= '2'
+    substring(glec,1,1) <= '2'
     --AND quota_rep_descr = 'COLIN MAXWELL'
 GROUP BY
     ROLLUP (

inquirey/osmf_months_shipped.sql

@@ -0,0 +1,22 @@
+SELECT
+    --o.glec
+    to_char(CASE WHEN extract(month FROM o.sdate) >= 6 THEN -5 ELSE 7 END + extract(month FROM o.sdate),'FM00')||' - '||to_char(o.sdate,'TMMon') order_month
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2019 AND version IN ('b24') AND iter = 'actuals'),0)          act2019
+    --,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2019 AND version IN ('b24') AND iter = 'actuals_plug'),0)     act2019
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2019 AND version IN ('b24')),0)                               total_baseline
+    ,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2024 ),0)                                                     plan2024
+FROM
+    rlarp.osmf o
+WHERE
+    true
+    --sseas IN (2023,2024)
+    --AND substring(glec,1,1) <= '2'
+    --AND quota_rep_descr = 'COLIN MAXWELL'
+GROUP BY
+    ROLLUP (
+        --o.glec,
+        to_char(CASE WHEN extract(month FROM o.sdate) >= 6 THEN -5 ELSE 7 END + extract(month FROM o.sdate),'FM00')||' - '||to_char(o.sdate,'TMMon')
+        )
+ORDER BY
+    --o.glec,
+    order_month

route_sql/scenario_package.sql

@@ -36,7 +36,8 @@ FROM
     rlarp.osm_pool
 WHERE
     where_clause
-    AND order_season IN (2023,2024)
+    --quota_rep_descr = 'MATTHEW STAAL'
+    AND order_season IN (2019,2024)
 GROUP BY
     order_season
     ,order_month
@@ -94,14 +95,14 @@ GROUP BY
     SELECT
         order_month
         ,seq
-        ,SUM(units) FILTER (WHERE order_season = 2023) "2023 qty"
+        ,SUM(units) FILTER (WHERE order_season = 2019)                                                              "2023 qty"
-        ,SUM(units) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan')) "2024 base qty"
+        ,SUM(units) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan'))          "2024 base qty"
-        ,SUM(units) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan')) "2024 adj qty"
+        ,SUM(units) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan'))      "2024 adj qty"
-        ,SUM(units) FILTER (WHERE order_season = 2024) "2024 tot qty"
+        ,SUM(units) FILTER (WHERE order_season = 2024)                                                              "2024 tot qty"
-        ,SUM(value_usd) FILTER (WHERE order_season = 2023) "2023 value_usd"
+        ,SUM(value_usd) FILTER (WHERE order_season = 2019)                                                          "2023 value_usd"
-        ,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan')) "2024 base value_usd"
+        ,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan'))      "2024 base value_usd"
-        ,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan')) "2024 adj value_usd"
+        ,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan'))  "2024 adj value_usd"
-        ,SUM(value_usd) FILTER (WHERE order_season = 2024) "2024 tot value_usd"
+        ,SUM(value_usd) FILTER (WHERE order_season = 2024)                                                          "2024 tot value_usd"
     FROM
         months
     GROUP BY