Attribute VB_Name = "handler" Option Explicit Public sql As String Public jsql As String Public scenario As String Public sc() As Variant 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....." 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 errorMsg As String) As Object Set scenario_package = makeHttpRequest("GET", "scenario_package", doc, errorMsg) End Function Sub pg_main_workset(catg As String, rep As String) Dim errorMsg As String Application.StatusBar = "Querying for " & rep & "'s pool of data..." Dim json As Object Set json = makeHttpRequest("GET", "get_pool", "{""scenario"":{""" & catg & """:""" & rep & """}}", errorMsg) If errorMsg <> "" Then MsgBox errorMsg, vbOKOnly + vbExclamation, "Couldn't " & rep & "'s pool of data." Exit Sub End If ReDim res(0, 34) 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" res(0, 34) = "pounds" 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 Sub request_adjust(doc As String, ByRef errorMsg As String) Dim json As Object Set json = JsonConverter.ParseJson(doc) Set json = makeHttpRequest("POST", json("type"), doc, errorMsg) If errorMsg <> "" Then Exit Sub End If ReDim res(json("x").Count - 1, 34) Dim i As Long 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") res(i, 34) = json("x")(i + 1)("pounds") Next i errorMsg = "" i = shData.UsedRange.Rows.Count + 1 Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True) shOrders.PivotTables("ptOrders").PivotCache.Refresh End Sub Sub load_config() Dim i As Integer '----server to use--------------------------------------------------------- handler.server = shConfig.Range("server").Value '---basis------------------------------------------------------------------ With shConfig.ListObjects("BASIS") For i = 1 To .DataBodyRange.Rows.Count ReDim Preserve handler.basis(i - 1) handler.basis(i - 1) = .DataBodyRange(i, 1) Next End With '---baseline----------------------------------------------------------------- With shConfig.ListObjects("BASELINE") For i = 1 To .DataBodyRange.Rows.Count ReDim Preserve handler.baseline(i - 1) handler.baseline(i - 1) = .DataBodyRange(i, 1) Next End With '---adjustments----------------------------------------------------------------- With shConfig.ListObjects("ADJUST") For i = 1 To .DataBodyRange.Rows.Count ReDim Preserve handler.adjust(i - 1) handler.adjust(i - 1) = .DataBodyRange(i, 1) Next End With '---plan version-------------------------------------------------------------- handler.plan = shConfig.Range("budget").Value 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 With shMonthUpdate Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") .Cells(1, 16) = JsonConverter.ConvertToJson(j) For i = 1 To 12 '------------volume------------------- .Cells(i + 1, 1) = co_num(pkg(i, 1), 0) .Cells(i + 1, 2) = co_num(pkg(i, 2), 0) .Cells(i + 1, 3) = co_num(pkg(i, 3), 0) .Cells(i + 1, 4) = 0 .Cells(i + 1, 5) = co_num(pkg(i, 4), 0) '------------value---------------------- .Cells(i + 1, 11) = co_num(pkg(i, 5), 0) .Cells(i + 1, 12) = co_num(pkg(i, 6), 0) .Cells(i + 1, 13) = co_num(pkg(i, 7), 0) .Cells(i + 1, 14) = 0 .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 .Cells(i + 1, 6) = 0 Else .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 .Cells(i, 7) <> 0 Then .Cells(i + 1, 7) = .Cells(i, 7) Else If pkg(13, 1) + pkg(13, 2) = 0 Then .Cells(i + 1, 7) = 0 Else .Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2)) End If End If Else .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 .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 Next i 'scenario .Range("R1:S1000").ClearContents For i = 0 To UBound(handler.sc, 1) .Cells(i + 1, 18) = handler.sc(i, 0) .Cells(i + 1, 19) = handler.sc(i, 1) Next i 'basket .Range("U1:AC100000").ClearContents Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True) Call Utils.SHTp_DumpVar(basket, .Name, 1, 26, False, False, True) shConfig.Range("rebuild").Value = 0 shConfig.Range("show_basket").Value = 0 shConfig.Range("new_part").Value = 0 shMonthView.LoadSheet End With 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 errorMsg As String) As Variant() Dim json As Object Set json = makeHttpRequest("GET", "list_changes", doc, errorMsg) If errorMsg <> "" Then Exit Function End If ReDim res(json("x").Count - 1, 7) Dim i As Long 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 Sub undo_changes(ByVal logid As Integer, ByRef errorMsg As String) Dim json As Object Set json = makeHttpRequest("GET", "undo_change", "{""logid"":" & logid & "}", errorMsg) logid = json("x")(1)("id") '---------loop through and get a list of each row that needs deleted?----- Dim i As Long Dim j As Long j = 0 For i = 1 To 100 If shData.Cells(1, i) = "logid" Then j = i Exit For End If Next i If j = 0 Then errorMsg = "Current data set is not tracking changes. Cannot isolate change locally." Exit Sub End If i = 2 With shData While .Cells(i, 1) <> "" If .Cells(i, j) = logid Then .Rows(i).Delete Else i = i + 1 End If Wend End With End Sub Sub history() changes.Show End Sub Function get_swap_fit(doc As String, ByRef errorMsg As String) As Variant() Dim json As Object Set json = makeHttpRequest("GET", "swap_fit", doc, errorMsg) Dim res() As Variant ReDim res(json("x").Count - 1, 3) Dim i As Integer 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