save my version that was on teams as 1.7

VBA/Windows_API.cls

@@ -0,0 +1,247 @@
+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

@@ -0,0 +1,81 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build 
+   Caption         =   "UserForm1"
+   ClientHeight    =   3015
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   8100
+   OleObjectBlob   =   "build.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "build"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Public part As String
+Public bill As String
+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
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+End Sub
+
+
+Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+
+    Select Case KeyCode
+        Case 13
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+
+End Sub
+
+
+Private Sub cbShip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+    Select Case KeyCode
+        Case 13
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+End Sub
+
+Private Sub UserForm_Activate()
+    
+    useval = False
+    
+    cbPart.value = part
+    cbBill.value = bill
+    cbShip.value = ship
+    
+    cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A2").CurrentRegion)
+    'cbPart.list(1).Remove
+    cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
+    'cbPart.list(1).Remove
+    cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
+    'cbPart.list(1).Remove
+    
+
+End Sub
+
+
+

VBA/changes.frm

@@ -0,0 +1,134 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes 
+   Caption         =   "History"
+   ClientHeight    =   7785
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   16710
+   OleObjectBlob   =   "changes.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "changes"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Private x As Variant
+
+Private Sub cbCancel_Click()
+
+    Me.Hide
+
+End Sub
+
+Private Sub cbUndo_Click()
+
+    
+    Call Me.delete_selected
+
+End Sub
+
+Private Sub lbHist_Change()
+
+    Dim i As Integer
+
+    For i = 0 To Me.lbHist.ListCount - 1
+        If Me.lbHist.Selected(i) Then
+            Me.tbPrint.value = x(i, 7)
+            Exit Sub
+        End If
+    Next i
+
+End Sub
+
+
+
+Private Sub lbHist_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+
+    Select Case KeyCode
+        Case 46
+            Call Me.delete_selected
+        Case 27
+            Call Me.Hide
+    End Select
+
+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)
+    If fail Then
+        Me.Hide
+        Exit Sub
+    End If
+    Me.lbHist.list = x
+    
+    lbHEAD.ColumnCount = lbHist.ColumnCount
+    lbHEAD.ColumnWidths = lbHist.ColumnWidths
+
+    ' add header elements
+    lbHEAD.clear
+    lbHEAD.AddItem
+    lbHEAD.list(0, 0) = "Modifier"
+    lbHEAD.list(0, 1) = "Owner"
+    lbHEAD.list(0, 2) = "When"
+    lbHEAD.list(0, 3) = "Tag"
+    lbHEAD.list(0, 4) = "Comment"
+    lbHEAD.list(0, 5) = "Sales"
+    lbHEAD.list(0, 6) = "id"
+    Dim tbo As New TheBigOne
+    Call tbo.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id")
+    
+    
+    ' make it pretty
+    'body.ZOrder (1)
+    'lbHEAD.ZOrder (0)
+    'lbHEAD.SpecialEffect = fmSpecialEffectFlat
+    'lbHEAD.BackColor = RGB(200, 200, 200)
+    'lbHEAD.Height = 10
+
+    ' align header to body (should be done last!)
+    'lbHEAD.width = lbHist.width
+    'lbHEAD.Left = lbHist.Left
+    'lbHEAD.Top = lbHist.Top - (lbHEAD.Height - 1)
+
+End Sub
+
+Sub delete_selected()
+
+    Dim logid As Integer
+    Dim i As Integer
+    Dim fail As Boolean
+    Dim proceed As Boolean
+    
+    If MsgBox("Permanently delete these changes?", vbOKCancel) = vbCancel Then
+        Exit Sub
+    End If
+    
+    
+    For i = 0 To Me.lbHist.ListCount - 1
+        If Me.lbHist.Selected(i) Then
+            Call handler.undo_changes(x(i, 6), fail)
+            If fail Then
+                MsgBox ("undo did not work")
+                Exit Sub
+            End If
+        End If
+    Next i
+    
+    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    
+    Me.lbHist.clear
+    Me.Hide
+
+End Sub

VBA/handler.bas

@@ -0,0 +1,643 @@
+Attribute VB_Name = "handler"
+Option Explicit
+
+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
+Public server As String
+Public plan As String
+Public basis() As Variant
+Public baseline() As Variant
+Public adjust() As Variant
+
+
+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
+    
+    fpvt.lbSDET.list = handler.sc
+    
+    showprice = False
+    
+    For i = 0 To UBound(handler.sc, 1)
+        If handler.sc(i, 0) = "part_descr" Then
+            showprice = True
+            Exit For
+        End If
+    Next i
+       
+    
+    fpvt.Show
+     
+
+
+End Sub
+
+Function scenario_package(doc As String, ByRef status As Boolean) As Object
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    
+    On Error GoTo errh
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/scenario_package", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+    Set scenario_package = json
+    
+errh:
+    If Err.Number <> 0 Then
+        status = False
+        MsgBox (Err.Description)
+        Set scenario_package = Nothing
+    Else
+        status = True
+    End If
+    
+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
+    Dim j As Long
+    Dim doc As String
+    Dim res() As Variant
+    Dim str() As String
+    
+    doc = "{""quota_rep"":""" & rep & """}"
+         
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", handler.server & "/get_pool", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+
+    If Mid(wr, 1, 1) <> "{" Then
+        MsgBox (wr)
+        Exit Sub
+    End If
+    Set json = JsonConverter.ParseJson(wr)
+    ReDim res(json("x").Count, 33)
+    
+    For i = 1 To UBound(res, 1)
+        res(i, 0) = json("x")(i)("bill_cust_descr")
+        res(i, 1) = json("x")(i)("billto_group")
+        res(i, 2) = json("x")(i)("ship_cust_descr")
+        res(i, 3) = json("x")(i)("shipto_group")
+        res(i, 4) = json("x")(i)("quota_rep_descr")
+        res(i, 5) = json("x")(i)("director")
+        res(i, 6) = json("x")(i)("segm")
+        res(i, 7) = json("x")(i)("substance")
+        res(i, 8) = json("x")(i)("chan")
+        res(i, 9) = json("x")(i)("chansub")
+        res(i, 10) = json("x")(i)("part_descr")
+        res(i, 11) = json("x")(i)("part_group")
+        res(i, 12) = json("x")(i)("branding")
+        res(i, 13) = json("x")(i)("majg_descr")
+        res(i, 14) = json("x")(i)("ming_descr")
+        res(i, 15) = json("x")(i)("majs_descr")
+        res(i, 16) = json("x")(i)("mins_descr")
+        res(i, 17) = json("x")(i)("order_season")
+        res(i, 18) = json("x")(i)("order_month")
+        res(i, 19) = json("x")(i)("ship_season")
+        res(i, 20) = json("x")(i)("ship_month")
+        res(i, 21) = json("x")(i)("request_season")
+        res(i, 22) = json("x")(i)("request_month")
+        res(i, 23) = json("x")(i)("promo")
+        res(i, 24) = json("x")(i)("value_loc")
+        res(i, 25) = json("x")(i)("value_usd")
+        res(i, 26) = json("x")(i)("cost_loc")
+        res(i, 27) = json("x")(i)("cost_usd")
+        res(i, 28) = json("x")(i)("units")
+        res(i, 29) = json("x")(i)("version")
+        res(i, 30) = json("x")(i)("iter")
+        res(i, 31) = json("x")(i)("logid")
+        res(i, 32) = json("x")(i)("tag")
+        res(i, 33) = json("x")(i)("comment")
+    Next i
+    
+    res(0, 0) = "bill_cust_descr"
+    res(0, 1) = "billto_group"
+    res(0, 2) = "ship_cust_descr"
+    res(0, 3) = "shipto_group"
+    res(0, 4) = "quota_rep_descr"
+    res(0, 5) = "director"
+    res(0, 6) = "segm"
+    res(0, 7) = "substance"
+    res(0, 8) = "chan"
+    res(0, 9) = "chansub"
+    res(0, 10) = "part_descr"
+    res(0, 11) = "part_group"
+    res(0, 12) = "branding"
+    res(0, 13) = "majg_descr"
+    res(0, 14) = "ming_descr"
+    res(0, 15) = "majs_descr"
+    res(0, 16) = "mins_descr"
+    res(0, 17) = "order_season"
+    res(0, 18) = "order_month"
+    res(0, 19) = "ship_season"
+    res(0, 20) = "ship_month"
+    res(0, 21) = "request_season"
+    res(0, 22) = "request_month"
+    res(0, 23) = "promo"
+    res(0, 24) = "value_loc"
+    res(0, 25) = "value_usd"
+    res(0, 26) = "cost_loc"
+    res(0, 27) = "cost_usd"
+    res(0, 28) = "units"
+    res(0, 29) = "version"
+    res(0, 30) = "iter"
+    res(0, 31) = "logid"
+    res(0, 32) = "tag"
+    res(0, 33) = "comment"
+    
+    Set json = Nothing
+
+    ReDim str(UBound(res, 1), UBound(res, 2))
+    
+    Worksheets("data").Cells.ClearContents
+    Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
+    
+
+End Sub
+
+Sub pull_rep()
+
+    openf.Show
+
+End Sub
+
+
+
+Function request_adjust(doc As String, ByRef fail As Boolean) As Object
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Long
+    Dim j As Long
+    Dim str() As String
+    
+    If doc = "" Then
+        fail = True
+        Exit Function
+    End If
+    
+    'update timestamp
+    Set json = JsonConverter.ParseJson(doc)
+    'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
+    'doc = JsonConverter.ConvertToJson(doc)
+    
+    server = Sheets("config").Cells(1, 2)
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "POST", server & "/" & json("type"), True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+    
+    If Mid(wr, 2, 5) = "error" Then
+        MsgBox (wr)
+        fail = True
+        Exit Function
+    End If
+    
+    If Mid(wr, 1, 6) = "<body>" Then
+        MsgBox (wr)
+        fail = True
+        Exit Function
+    End If
+    
+    If Mid(wr, 1, 6) = "<!DOCT" Then
+        MsgBox (wr)
+        fail = True
+        Exit Function
+    End If
+    
+    If Mid(wr, 1, 6) = "null" Then
+        MsgBox ("API route not implemented")
+        fail = True
+        Exit Function
+    End If
+
+    Set json = JsonConverter.ParseJson(wr)
+    
+    If IsNull(json("x")) Then
+        MsgBox ("no adjustment was made")
+        fail = False
+        Exit Function
+    End If
+    
+    ReDim res(json("x").Count - 1, 33)
+    
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("bill_cust_descr")
+        res(i, 1) = json("x")(i + 1)("billto_group")
+        res(i, 2) = json("x")(i + 1)("ship_cust_descr")
+        res(i, 3) = json("x")(i + 1)("shipto_group")
+        res(i, 4) = json("x")(i + 1)("quota_rep_descr")
+        res(i, 5) = json("x")(i + 1)("director")
+        res(i, 6) = json("x")(i + 1)("segm")
+        res(i, 7) = json("x")(i + 1)("substance")
+        res(i, 8) = json("x")(i + 1)("chan")
+        res(i, 9) = json("x")(i + 1)("chansub")
+        res(i, 10) = json("x")(i + 1)("part_descr")
+        res(i, 11) = json("x")(i + 1)("part_group")
+        res(i, 12) = json("x")(i + 1)("branding")
+        res(i, 13) = json("x")(i + 1)("majg_descr")
+        res(i, 14) = json("x")(i + 1)("ming_descr")
+        res(i, 15) = json("x")(i + 1)("majs_descr")
+        res(i, 16) = json("x")(i + 1)("mins_descr")
+        res(i, 17) = json("x")(i + 1)("order_season")
+        res(i, 18) = json("x")(i + 1)("order_month")
+        res(i, 19) = json("x")(i + 1)("ship_season")
+        res(i, 20) = json("x")(i + 1)("ship_month")
+        res(i, 21) = json("x")(i + 1)("request_season")
+        res(i, 22) = json("x")(i + 1)("request_month")
+        res(i, 23) = json("x")(i + 1)("promo")
+        res(i, 24) = json("x")(i + 1)("value_loc")
+        res(i, 25) = json("x")(i + 1)("value_usd")
+        res(i, 26) = json("x")(i + 1)("cost_loc")
+        res(i, 27) = json("x")(i + 1)("cost_usd")
+        res(i, 28) = json("x")(i + 1)("units")
+        res(i, 29) = json("x")(i + 1)("version")
+        res(i, 30) = json("x")(i + 1)("iter")
+        res(i, 31) = json("x")(i + 1)("logid")
+        res(i, 32) = json("x")(i + 1)("tag")
+        res(i, 33) = json("x")(i + 1)("comment")
+    Next i
+    
+    Set json = Nothing
+
+    ReDim str(UBound(res, 1), UBound(res, 2))
+    
+'    For i = 0 To UBound(res, 1)
+'        For j = 0 To UBound(res, 2)
+'            If IsNull(res(i, j)) Then
+'                str(i, j) = ""
+'            Else
+'                str(i, j) = res(i, j)
+'            End If
+'        Next j
+'    Next i
+    
+    i = 1
+    Do Until Sheets("data").Cells(i, 1) = ""
+        i = i + 1
+    Loop
+    
+    Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
+    
+    
+    'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
+    
+    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    
+End Function
+
+Sub load_config()
+
+    Dim i As Integer
+    Dim j As Integer
+    '----server to use---------------------------------------------------------
+    handler.server = Sheets("config").Cells(1, 2)
+    '---basis-----------------------------------------------------------------
+    ReDim handler.basis(100)
+    i = 2
+    j = 0
+    Do While Sheets("config").Cells(2, i) <> ""
+        handler.basis(j) = Sheets("config").Cells(2, i)
+        j = j + 1
+        i = i + 1
+    Loop
+    ReDim Preserve handler.basis(j - 1)
+    '---baseline-----------------------------------------------------------------
+    ReDim handler.baseline(100)
+    i = 2
+    j = 0
+    Do While Sheets("config").Cells(3, i) <> ""
+        handler.baseline(j) = Sheets("config").Cells(3, i)
+        j = j + 1
+        i = i + 1
+    Loop
+    ReDim Preserve handler.baseline(j - 1)
+    '---adjustments-----------------------------------------------------------------
+    ReDim handler.adjust(100)
+    i = 2
+    j = 0
+    Do While Sheets("config").Cells(4, i) <> ""
+        handler.adjust(j) = Sheets("config").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)
+    
+End Sub
+
+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 & "}")
+    sh.Cells(1, 16) = JsonConverter.ConvertToJson(j)
+    
+    For i = 0 To 12
+        '------------volume-------------------
+        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----------------------
+        sh.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
+        sh.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
+        sh.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
+        sh.Cells(i + 1, 14) = 0
+        sh.Cells(i + 1, 15) = co_num(pkg(i, 8), 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--
+            If co_num(pkg(i, 2), 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, 7) <> 0 Then
+                    sh.Cells(i + 1, 7) = sh.Cells(i, 7)
+                Else
+                    If pkg(13, 1) + pkg(13, 2) = 0 Then
+                        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)
+            End If
+            
+            '--adjust--
+            If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
+                sh.Cells(i + 1, 8) = 0
+            Else
+                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))
+            End If
+            
+            '--current adjust--
+            sh.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 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
+                        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)
+            End If
+            
+        End If
+        
+    Next i
+    
+    'scenario
+    Sheets("_month").Range("R1:S1000").ClearContents
+    For i = 0 To UBound(handler.sc, 1)
+        sh.Cells(i + 1, 18) = handler.sc(i, 0)
+        sh.Cells(i + 1, 19) = handler.sc(i, 1)
+    Next i
+    
+    'basket
+    sh.Range("U1:AC100000").ClearContents
+    Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
+    Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
+    Sheets("config").Cells(5, 2) = 0
+    Sheets("config").Cells(6, 2) = 0
+    Sheets("config").Cells(7, 2) = 0
+    
+    months.load_sheet
+    
+    
+End Sub
+
+Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
+
+    If one = "" Or IsNull(one) Then
+        co_num = two
+    Else
+        co_num = one
+    End If
+
+End Function
+
+
+Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Integer
+    Dim j As Integer
+    Dim res() As Variant
+    
+    If doc = "" Then
+        fail = True
+        Exit Function
+    End If
+    
+    server = Sheets("config").Cells(1, 2)
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/list_changes", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+    
+    Set json = JsonConverter.ParseJson(wr)
+    
+    If IsNull(json("x")) Then
+        MsgBox ("no history")
+        fail = True
+        Exit Function
+    End If
+    
+    ReDim res(json("x").Count - 1, 7)
+    
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("user")
+        res(i, 1) = json("x")(i + 1)("quota_rep_descr")
+        res(i, 2) = json("x")(i + 1)("stamp")
+        res(i, 3) = json("x")(i + 1)("tag")
+        res(i, 4) = json("x")(i + 1)("comment")
+        res(i, 5) = json("x")(i + 1)("sales")
+        res(i, 6) = json("x")(i + 1)("id")
+        res(i, 7) = json("x")(i + 1)("doc")
+    Next i
+    
+    list_changes = res
+
+End Function
+
+Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant()
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Integer
+    Dim j As Integer
+    Dim res() As Variant
+    Dim doc As String
+    Dim ds As Worksheet
+    
+    doc = "{""logid"":" & logid & "}"
+    
+    server = handler.server
+        
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/undo_change", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+    
+    Set json = JsonConverter.ParseJson(wr)
+    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
+            j = i
+            Exit For
+        End If
+    Next i
+    
+    If j = 0 Then
+        MsgBox ("current data set is not tracking changes, cannot isolate change locally")
+        fail = True
+        Exit Function
+    End If
+    
+    i = 2
+    While ds.Cells(i, 1) <> ""
+        If ds.Cells(i, j) = logid Then
+            ds.Rows(i).Delete
+        Else
+            i = i + 1
+        End If
+    Wend
+    
+    
+
+End Function
+
+
+Sub history()
+
+    changes.Show
+
+End Sub
+
+Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    Dim i As Integer
+    Dim j As Integer
+    Dim res() As Variant
+    
+    If doc = "" Then
+        fail = True
+        Exit Function
+    End If
+    
+    server = Sheets("config").Cells(1, 2)
+    
+    With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
+        .Open "GET", server & "/swap_fit", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+    
+    Set json = JsonConverter.ParseJson(wr)
+    
+    If IsNull(json("x")) Then
+        MsgBox ("no history")
+        fail = True
+        Exit Function
+    End If
+    
+    ReDim res(json("x").Count - 1, 3)
+    
+    For i = 0 To UBound(res, 1)
+        res(i, 0) = json("x")(i + 1)("part")
+        res(i, 1) = json("x")(i + 1)("value_usd")
+        res(i, 2) = json("x")(i + 1)("swap")
+        res(i, 3) = json("x")(i + 1)("fit")
+    Next i
+    
+    get_swap_fit = res
+
+End Function

VBA/openf.frm

@@ -0,0 +1,51 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf 
+   Caption         =   "Open a Forecast"
+   ClientHeight    =   2025
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   3825
+   OleObjectBlob   =   "openf.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "openf"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Private Sub cbCancel_Click()
+    
+    openf.Hide
+    
+End Sub
+
+Private Sub cbOK_Click()
+
+    Application.StatusBar = "Retrieving data for " & cbDSM.value & "....."
+
+    openf.Caption = "retrieving data......"
+    Call handler.pg_main_workset(cbDSM.value)
+    Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
+    Application.StatusBar = False
+    openf.Hide
+
+End Sub
+
+Private Sub UserForm_Activate()
+
+    'handler.server = "http://192.168.1.69:3000"
+    handler.server = Sheets("config").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)
+    
+    For i = 1 To UBound(d, 2)
+        Call cbDSM.AddItem(d(0, i))
+    Next i
+
+
+End Sub
+

VBA/part.frm

@@ -0,0 +1,48 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part 
+   Caption         =   "Part Picker"
+   ClientHeight    =   1080
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   8100
+   OleObjectBlob   =   "part.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "part"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+
+Public part As String
+Public bill As String
+Public ship As String
+Public useval As Boolean
+Option Explicit
+
+
+Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
+
+    Select Case KeyCode
+        Case 13
+            useval = True
+            Me.Hide
+        Case 27
+            useval = False
+            Me.Hide
+    End Select
+
+End Sub
+
+
+
+Private Sub UserForm_Activate()
+    
+    useval = False
+    
+    cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
+    
+
+End Sub
+
+

VBA/pivot.cls

@@ -0,0 +1,122 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "pivot"
+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)
+
+    If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
+        Exit Sub
+    End If
+
+    On Error GoTo nopiv
+
+    If Target.Cells.PivotTable Is Nothing Then
+        Exit Sub
+    End If
+
+    Cancel = True
+
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+    
+    Dim ri As PivotItemList
+    Dim ci As PivotItemList
+    Dim df As Object
+    Dim rd As Object
+    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
+    Set df = Target.Cells.PivotCell.DataField
+
+    Set rd = Target.Cells.PivotTable.RowFields
+    Set cd = Target.Cells.PivotTable.ColumnFields
+    
+    ReDim handler.sc(ri.Count, 1)
+    Set pt = Target.Cells.PivotCell.PivotTable
+    
+    handler.sql = ""
+    handler.jsql = ""
+
+    For i = 1 To ri.Count
+        If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
+        If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
+        handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'"
+        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(ri(i).Name) & """"
+        handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
+        handler.sc(i - 1, 1) = ri(i).Name
+    Next i
+    
+    scenario = "{" & handler.jsql & "}"
+    
+    Call handler.load_config
+    Call handler.load_fpvt
+    
+nopiv:
+
+End Sub
+
+Function piv_pos(list As Object, target_pos As Long) As Long
+
+    Dim i As Long
+    
+    For i = 1 To list.Count
+        If list(i).Position = target_pos Then
+            piv_pos = i
+            Exit Function
+        End If
+    Next i
+    'should not get to this point
+
+End Function
+
+Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
+
+    Dim i As Integer
+    
+    For i = 1 To pt.PivotFields.Count
+        If pt.PivotFields(i).Name = field_name Then
+            piv_fld_index = i
+            Exit Function
+        End If
+    Next i
+
+End Function
+
+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
+
+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
+
+

VBA/pivot1.cls

@@ -0,0 +1,122 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "pivot1"
+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)
+
+    If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
+        Exit Sub
+    End If
+
+    On Error GoTo nopiv
+
+    If Target.Cells.PivotTable Is Nothing Then
+        Exit Sub
+    End If
+
+    Cancel = True
+
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+    
+    Dim ri As PivotItemList
+    Dim ci As PivotItemList
+    Dim df As Object
+    Dim rd As Object
+    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
+    Set df = Target.Cells.PivotCell.DataField
+
+    Set rd = Target.Cells.PivotTable.RowFields
+    Set cd = Target.Cells.PivotTable.ColumnFields
+    
+    ReDim handler.sc(ri.Count, 1)
+    Set pt = Target.Cells.PivotCell.PivotTable
+    
+    handler.sql = ""
+    handler.jsql = ""
+
+    For i = 1 To ri.Count
+        If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
+        If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
+        handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'"
+        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(ri(i).Name) & """"
+        handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
+        handler.sc(i - 1, 1) = ri(i).Name
+    Next i
+    
+    scenario = "{" & handler.jsql & "}"
+    
+    Call handler.load_config
+    Call handler.load_fpvt
+    
+nopiv:
+
+End Sub
+
+Function piv_pos(list As Object, target_pos As Long) As Long
+
+    Dim i As Long
+    
+    For i = 1 To list.Count
+        If list(i).Position = target_pos Then
+            piv_pos = i
+            Exit Function
+        End If
+    Next i
+    'should not get to this point
+
+End Function
+
+Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
+
+    Dim i As Integer
+    
+    For i = 1 To pt.PivotFields.Count
+        If pt.PivotFields(i).Name = field_name Then
+            piv_fld_index = i
+            Exit Function
+        End If
+    Next i
+
+End Function
+
+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
+
+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
+
+