Add options to query by director or segment. Also speed it up A LOT.

VBA/handler.bas

@@ -53,8 +53,12 @@ Function scenario_package(doc As String, ByRef status As Boolean) As Object
         .Open "GET", server & "/scenario_package", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
+        Debug.Print "GET /scenario_package (";
+        Dim t As Single
+        t = Timer
         .WaitForResponse
         wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
     End With
 
     Set json = JsonConverter.ParseJson(wr)
@@ -71,32 +75,37 @@ errh:
 
 End Function
 
-Sub pg_main_workset(rep As String)
+
+Sub pg_main_workset(catg As String, rep As String)
 
     Dim req As New WinHttp.WinHttpRequest
     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 & """}"
+    doc = "{""scenario"":{""" & catg & """:""" & rep & """}}"
     
+    Application.StatusBar = "Querying for " & rep & "'s pool of data..."
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
         .Open "GET", handler.server & "/get_pool", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
+        Debug.Print "GET /get_pool (";
+        Dim t As Single
+        t = Timer
         .WaitForResponse
         wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
     End With
 
     If Mid(wr, 1, 1) <> "{" Then
         MsgBox (wr)
         Exit Sub
     End If
+
+    Application.StatusBar = "Parsing query results..."
     Set json = JsonConverter.ParseJson(wr)
 
     If IsNull(json("x")) Then
@@ -104,46 +113,7 @@ Sub pg_main_workset(rep As String)
         Exit Sub
     End If
 
-    ReDim res(json("x").Count, 34)
+    ReDim res(0, 34)
-    
-    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")
-        res(i, 34) = json("x")(i)("pounds")
-    Next i
-    
     res(0, 0) = "bill_cust_descr"
     res(0, 1) = "billto_group"
     res(0, 2) = "ship_cust_descr"
@@ -180,20 +150,81 @@ Sub pg_main_workset(rep As String)
     res(0, 33) = "comment"
     res(0, 34) = "pounds"
 
-    Set json = Nothing
-
-    ReDim str(UBound(res, 1), UBound(res, 2))
-    
     shData.Cells.ClearContents
     Call Utils.SHTp_DumpVar(res, shData.Name, 1, 1, False, True, True)
 
+    Dim batchSize As Integer
+    batchSize = 1000
+    Dim totalRows As Long
+    totalRows = json("x").Count
+    Dim jsonRow As Long
+    jsonRow = 1
+    Dim sheetRow As Long
+    sheetRow = 2
+    Dim arrayRow As Long
 
+    ' While the JSON array still has rows,
+    '   1. move the 1st one to a VBA 2-D array, deleting it from the JSON array.
+    '   2. When 1000 have been copied, put the values onto the worksheet, and
+    '      empty the VBA array.
+    ' Splitting the JSON array into smaller batches when creating the VBA array
+    ' means there is less memory needed for the operation.
+    Do While json("x").Count > 0
+        If jsonRow Mod batchSize = 1 Then
+            ReDim res(batchSize - 1, 34)
+            arrayRow = 0
+        End If
+        res(arrayRow, 0) = json("x")(1)("bill_cust_descr")
+        res(arrayRow, 1) = json("x")(1)("billto_group")
+        res(arrayRow, 2) = json("x")(1)("ship_cust_descr")
+        res(arrayRow, 3) = json("x")(1)("shipto_group")
+        res(arrayRow, 4) = json("x")(1)("quota_rep_descr")
+        res(arrayRow, 5) = json("x")(1)("director")
+        res(arrayRow, 6) = json("x")(1)("segm")
+        res(arrayRow, 7) = json("x")(1)("substance")
+        res(arrayRow, 8) = json("x")(1)("chan")
+        res(arrayRow, 9) = json("x")(1)("chansub")
+        res(arrayRow, 10) = json("x")(1)("part_descr")
+        res(arrayRow, 11) = json("x")(1)("part_group")
+        res(arrayRow, 12) = json("x")(1)("branding")
+        res(arrayRow, 13) = json("x")(1)("majg_descr")
+        res(arrayRow, 14) = json("x")(1)("ming_descr")
+        res(arrayRow, 15) = json("x")(1)("majs_descr")
+        res(arrayRow, 16) = json("x")(1)("mins_descr")
+        res(arrayRow, 17) = json("x")(1)("order_season")
+        res(arrayRow, 18) = json("x")(1)("order_month")
+        res(arrayRow, 19) = json("x")(1)("ship_season")
+        res(arrayRow, 20) = json("x")(1)("ship_month")
+        res(arrayRow, 21) = json("x")(1)("request_season")
+        res(arrayRow, 22) = json("x")(1)("request_month")
+        res(arrayRow, 23) = json("x")(1)("promo")
+        res(arrayRow, 24) = json("x")(1)("value_loc")
+        res(arrayRow, 25) = json("x")(1)("value_usd")
+        res(arrayRow, 26) = json("x")(1)("cost_loc")
+        res(arrayRow, 27) = json("x")(1)("cost_usd")
+        res(arrayRow, 28) = json("x")(1)("units")
+        res(arrayRow, 29) = json("x")(1)("version")
+        res(arrayRow, 30) = json("x")(1)("iter")
+        res(arrayRow, 31) = json("x")(1)("logid")
+        res(arrayRow, 32) = json("x")(1)("tag")
+        res(arrayRow, 33) = json("x")(1)("comment")
+        res(arrayRow, 34) = json("x")(1)("pounds")
+        json("x").Remove 1
+        arrayRow = arrayRow + 1
+        If jsonRow Mod batchSize = 0 Or json("x").Count = 0 Then
+            Application.StatusBar = "Populating spreadsheet: " & Format(jsonRow, "#,##0") & " of " & Format(totalRows, "#,##0") & " rows..."
+            Call Utils.SHTp_DumpVar(res, shData.Name, sheetRow, 1, False, True, True)
+            sheetRow = sheetRow + batchSize
+        End If
+        jsonRow = jsonRow + 1
+    Loop
+
+    Set json = Nothing
+    Application.StatusBar = False
 End Sub
 
 Sub pull_rep()
-
     openf.Show
-
 End Sub
 
 
@@ -224,8 +255,12 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
         .Open "POST", server & "/" & json("type"), True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
+        Debug.Print "GET /"; json("type"); " (";
+        Dim t As Single
+        t = Timer
         .WaitForResponse
         wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
     End With
 
     If Mid(wr, 2, 5) = "error" Then
@@ -497,8 +532,12 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
         .Open "GET", server & "/list_changes", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
+        Debug.Print "GET /list_changes (";
+        Dim t As Single
+        t = Timer
         .WaitForResponse
         wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
     End With
 
     Set json = JsonConverter.ParseJson(wr)
@@ -546,8 +585,12 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
         .Open "GET", server & "/undo_change", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
+        Debug.Print "GET /undo_change (";
+        Dim t As Single
+        t = Timer
         .WaitForResponse
         wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
     End With
 
     Set json = JsonConverter.ParseJson(wr)
@@ -610,8 +653,12 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
         .Open "GET", server & "/swap_fit", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
+        Debug.Print "GET /swap_fit (";
+        Dim t As Single
+        t = Timer
         .WaitForResponse
         wr = .ResponseText
+        Debug.Print Timer - t; "sec): "; Left(wr, 200)
     End With
 
     Set json = JsonConverter.ParseJson(wr)
@@ -634,3 +681,6 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
     get_swap_fit = res
 
 End Function
+
+
+

VBA/openf.frm

@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf 
    Caption         =   "Open a Forecast"
-   ClientHeight    =   1365
+   ClientHeight    =   2400
    ClientLeft      =   120
    ClientTop       =   465
-   ClientWidth     =   6825
+   ClientWidth     =   8220.001
    OleObjectBlob   =   "openf.frx":0000
    StartUpPosition =   1  'CenterOwner
 End
@@ -14,27 +14,44 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 Private Sub cbCancel_Click()
-    
     openf.Hide
-    
 End Sub
 
 Private Sub cbOK_Click()
-
+    If opDSM.Value Then
-    Application.StatusBar = "Retrieving data for " & cbDSM.Value & "....."
+        Call handler.pg_main_workset("quota_rep_descr", cbDSM.Value)
-
+    ElseIf opDirector.Value Then
-    openf.Caption = "Retrieving data......"
+        Call handler.pg_main_workset("director", cbDirector.Value)
-    Call handler.pg_main_workset(cbDSM.Value)
+    ElseIf opSegment.Value Then
+        Call handler.pg_main_workset("segm", cbSegment.Value)
+    End If
     shOrders.PivotTables("ptOrders").PivotCache.Refresh
-    Application.StatusBar = False
     openf.Hide
+End Sub
 
+Private Sub opDSM_Click()
+    cbDSM.Enabled = True
+    cbDirector.Enabled = False
+    cbSegment.Enabled = False
+End Sub
+
+Private Sub opDirector_Click()
+    cbDSM.Enabled = False
+    cbDirector.Enabled = True
+    cbSegment.Enabled = False
+End Sub
+
+Private Sub opSegment_Click()
+    cbDSM.Enabled = False
+    cbDirector.Enabled = False
+    cbSegment.Enabled = True
 End Sub
 
 Private Sub UserForm_Activate()
-
     handler.server = shConfig.Range("server").Value
     cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.Value
-
+    cbDirector.list = shConfig.ListObjects("DIRECTORS").DataBodyRange.Value
+    cbSegment.list = shConfig.ListObjects("SEGMENTS").DataBodyRange.Value
 End Sub
 
+

index.js

@@ -75,14 +75,30 @@ server.get('/test_sql', function(req, res) {
 server.get('/get_pool', bodyParser.json(), function(req, res) {
 
     var sql = "";
-    var args = [req.body.quota_rep];
+    var w = "";
+    var c = 1;
+    var d = 1;
+    var args = [];
     var path = './route_sql/get_pool.sql';
     console.log(`${new Date().toISOString()}: GET /get_pool  (Get all data for one DSM.)... SQL: ${path} ${"-._.".repeat(20)}`);
 
     var callback = function(arg) {
         sql = arg;
-        console.log(req.body.quota_rep);
+
-        sql = sql.replace("rep_replace", req.body.quota_rep);
+        if (req.body.quota_rep) {
+            // ensure backward compatibility
+            console.log('Converting old format...', req.body);
+            req.body = {'scenario':{'quota_rep_descr':req.body.quota_rep}};
+        }
+
+        ({ c, w, d } = build_where(req, c, w, d, args));
+
+        if (c == 1) {
+            res.send("no body was sent");
+            return;
+        }
+        console.log(req.body);
+        sql = sql.replace(new RegExp("where_clause", 'g'), w);
         console.log(sql);
         Postgres.FirstRow(sql, [], res)
     };
@@ -669,7 +685,7 @@ server.post('/new_basket', bodyParser.json(), function(req, res) {
 function build_where(req, c, w, d, args) {
     for (var i in req.body.scenario) {
         // console.log(i);
-        ///console.log(req.body[i]);
+        // console.log(req.body[i]);
         if (c > 1) {
             w = w +
                 `

route_sql/get_pool.sql

@@ -45,7 +45,7 @@ SELECT
 FROM
     rlarp.osm_pool
 WHERE
-    quota_rep_descr = 'rep_replace'
+    where_clause
 GROUP BY
         ---------customer info-----------------
     bill_cust_descr