469 lines
15 KiB
QBasic
469 lines
15 KiB
QBasic
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
|
|
|
|
|
|
|