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 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.ListBox1.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 .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 .Open "GET", handler.server & "/get_pool", True .SetRequestHeader "Content-Type", "application/json" .Send doc .WaitForResponse wr = .ResponseText End With Set json = JsonConverter.ParseJson(wr) ReDim res(json("x").Count, 32) 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_descr") res(i, 6) = json("x")(i)("segm") res(i, 7) = json("x")(i)("mod_chan") res(i, 8) = json("x")(i)("mod_chansub") res(i, 9) = json("x")(i)("majg_descr") res(i, 10) = json("x")(i)("ming_descr") res(i, 11) = json("x")(i)("majs_descr") res(i, 12) = json("x")(i)("mins_descr") res(i, 13) = json("x")(i)("brand") res(i, 14) = json("x")(i)("part_family") res(i, 15) = json("x")(i)("part_group") res(i, 16) = json("x")(i)("branding") res(i, 17) = json("x")(i)("color") res(i, 18) = json("x")(i)("part_descr") res(i, 19) = json("x")(i)("order_season") res(i, 20) = json("x")(i)("order_month") res(i, 21) = json("x")(i)("ship_season") res(i, 22) = json("x")(i)("ship_month") res(i, 23) = json("x")(i)("request_season") res(i, 24) = json("x")(i)("request_month") res(i, 25) = json("x")(i)("promo") res(i, 26) = json("x")(i)("version") res(i, 27) = json("x")(i)("iter") res(i, 28) = json("x")(i)("value_loc") res(i, 29) = json("x")(i)("value_usd") res(i, 30) = json("x")(i)("cost_loc") res(i, 31) = json("x")(i)("cost_usd") res(i, 32) = json("x")(i)("units") 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_descr" res(0, 6) = "segm" res(0, 7) = "mod_chan" res(0, 8) = "mod_chansub" res(0, 9) = "majg_descr" res(0, 10) = "ming_descr" res(0, 11) = "majs_descr" res(0, 12) = "mins_descr" res(0, 13) = "brand" res(0, 14) = "part_family" res(0, 15) = "part_group" res(0, 16) = "branding" res(0, 17) = "color" res(0, 18) = "part_descr" res(0, 19) = "order_season" res(0, 20) = "order_month" res(0, 21) = "ship_season" res(0, 22) = "ship_month" res(0, 23) = "request_season" res(0, 24) = "request_month" res(0, 25) = "promo" res(0, 26) = "version" res(0, 27) = "iter" res(0, 28) = "value_loc" res(0, 29) = "value_usd" res(0, 30) = "cost_loc" res(0, 31) = "cost_usd" res(0, 32) = "units" 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 Call x.SHTp_Dump(str, "data", 1, 1, True, False, 28, 29, 30, 31, 32) End Sub Sub pull_rep() openf.Show End Sub Function request_adjust(doc As String) As Object Dim req As New WinHttp.WinHttpRequest Dim json As Object Dim wr As String Dim i As Integer Dim j As Integer Dim str() As String Set json = JsonConverter.ParseJson(doc) With req .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) Exit Function End If If Mid(wr, 1, 6) = "" Then MsgBox (wr) Exit Function End If Set json = JsonConverter.ParseJson(wr) If IsNull(json("x")) Then MsgBox ("no adjustment was made") Exit Function End If ReDim res(json("x").Count - 1, 32) For i = 1 To UBound(res, 1) + 1 res(i - 1, 0) = json("x")(i)("bill_cust_descr") res(i - 1, 1) = json("x")(i)("billto_group") res(i - 1, 2) = json("x")(i)("ship_cust_descr") res(i - 1, 3) = json("x")(i)("shipto_group") res(i - 1, 4) = json("x")(i)("quota_rep_descr") res(i - 1, 5) = json("x")(i)("director_descr") res(i - 1, 6) = json("x")(i)("segm") res(i - 1, 7) = json("x")(i)("mod_chan") res(i - 1, 8) = json("x")(i)("mod_chansub") res(i - 1, 9) = json("x")(i)("majg_descr") res(i - 1, 10) = json("x")(i)("ming_descr") res(i - 1, 11) = json("x")(i)("majs_descr") res(i - 1, 12) = json("x")(i)("mins_descr") res(i - 1, 13) = json("x")(i)("brand") res(i - 1, 14) = json("x")(i)("part_family") res(i - 1, 15) = json("x")(i)("part_group") res(i - 1, 16) = json("x")(i)("branding") res(i - 1, 17) = json("x")(i)("color") res(i - 1, 18) = json("x")(i)("part_descr") res(i - 1, 19) = json("x")(i)("order_season") res(i - 1, 20) = json("x")(i)("order_month") res(i - 1, 21) = json("x")(i)("ship_season") res(i - 1, 22) = json("x")(i)("ship_month") res(i - 1, 23) = json("x")(i)("request_season") res(i - 1, 24) = json("x")(i)("request_month") res(i - 1, 25) = json("x")(i)("promo") res(i - 1, 26) = json("x")(i)("version") res(i - 1, 27) = json("x")(i)("iter") res(i - 1, 28) = json("x")(i)("value_loc") res(i - 1, 29) = json("x")(i)("value_usd") res(i - 1, 30) = json("x")(i)("cost_loc") res(i - 1, 31) = json("x")(i)("cost_usd") res(i - 1, 32) = json("x")(i)("units") 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 Do Until Sheets("data").Cells(i, 1) = "" i = i + 1 Loop 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) End Sub