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) = "" Then MsgBox (wr) fail = True Exit Function End If If Mid(wr, 1, 6) = " "" 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