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 Sub month_tosheet(ByRef pkg() As Variant) Dim j As Object Dim i As Integer 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 sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2)) End If Else sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2) End If '--adjust-- If co_num(pkg(i, 3), 0) = 0 Then sh.Cells(i + 1, 8) = 0 Else sh.Cells(i + 1, 8) = pkg(i, 7) / pkg(i, 3) 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 sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2)) End If Else sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4) End If '--json-- End If Next i 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