save changes through forecast v0.5

This commit is contained in:
Trowbridge 2019-03-14 13:52:41 -04:00
parent 42fad8ab1a
commit 7f3f858744
5 changed files with 263 additions and 79 deletions

198
fpvt.frm
View File

@ -62,8 +62,11 @@ End Sub
Private Sub butAdjust_Click() Private Sub butAdjust_Click()
MsgBox ("adjustment posted")
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust))
Me.Hide Me.Hide
End Sub End Sub
Private Sub butCancel_Click() Private Sub butCancel_Click()
@ -225,10 +228,14 @@ Private Sub opPlugVol_Click()
End Sub End Sub
Private Sub tbFcPrice_Change() Private Sub tbFcPrice_Change()
If load_tb Then Exit Sub
set_Price = True
If opEditPrice Then calc_price If opEditPrice Then calc_price
set_Price = False
End Sub End Sub
Private Sub tbFcVal_Change() Private Sub tbFcVal_Change()
If load_tb Then Exit Sub
If opEditSales Then calc_val If opEditSales Then calc_val
End Sub End Sub
@ -276,10 +283,7 @@ Private Sub UserForm_Activate()
Dim k As Long Dim k As Long
Dim ok As Boolean Dim ok As Boolean
'handler.server = "http://10.56.1.20:3000" Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
handler.server = "http://192.168.1.69:3000"
Set sp = handler.scenario_package(handler.scenario, ok)
If Not ok Then If Not ok Then
fpvt.Hide fpvt.Hide
@ -290,30 +294,35 @@ Private Sub UserForm_Activate()
'---show existing adjustment if there is one---- '---show existing adjustment if there is one----
fpvt.mod_adjust = False fpvt.mod_adjust = False
fpvt.tbPadjVol.Text = 0 pVol = 0
fpvt.tbPadjVal.Text = 0 pVal = 0
bVol = 0
bVal = 0
For i = 1 To sp("package")("totals").Count For i = 1 To sp("package")("totals").Count
Select Case sp("package")("totals")(i)("order_season") Select Case sp("package")("totals")(i)("order_season")
Case 2020 Case 2020
Select Case sp("package")("totals")(i)("iter") Select Case Me.iter_def(sp("package")("totals")(i)("iter"))
Case "copy" Case "baseline"
fpvt.tbBaseVol.Text = Format(sp("package")("totals")(i)("units"), "#,###") bVol = bVol + sp("package")("totals")(i)("units")
fpvt.tbBaseVal.Text = Format(sp("package")("totals")(i)("value_usd"), "#,###") bVal = bVal + sp("package")("totals")(i)("value_usd")
If sp("package")("totals")(i)("units") <> 0 Then fpvt.tbBasePrice.Text = Format(sp("package")("totals")(i)("value_usd") / sp("package")("totals")(i)("units"), "#.000") If bVol <> 0 Then bPrc = bVal / bVol
Case "adjustment" Case "adjust"
fpvt.tbPadjVol.Text = Format(sp("package")("totals")(i)("units"), "#,###") pVol = pVol + sp("package")("totals")(i)("units")
fpvt.tbPadjVal.Text = Format(sp("package")("totals")(i)("value_usd"), "#,###") pVal = pVal + sp("package")("totals")(i)("value_usd")
Case "exclude"
End Select End Select
End Select End Select
Next i Next i
fpvt.tbFcVol.value = Format(CDbl(fpvt.tbBaseVol.value) + CDbl(fpvt.tbPadjVol.value), "#,###") fVol = bVol + pVol
fpvt.tbFcVal.value = Format(CDbl(fpvt.tbBaseVal.value) + CDbl(fpvt.tbPadjVal.value), "#") fVal = bVal + pVal
fpvt.tbFcPrice.value = Format(CDbl(fpvt.tbFcVal.value) / CDbl(fpvt.tbFcVol.value), "#.000") fPrc = fVal / fVol
fpvt.tbPadjPrice.value = Format((CDbl(fpvt.tbPadjVal.value) + CDbl(tbBaseVal.value)) / (CDbl(fpvt.tbBaseVol.value) + CDbl(tbPadjVol.value)) - CDbl(tbBaseVal) / CDbl(tbBaseVol), "#.000") pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
Me.load_mbox_ann
'---------------------------------------populate monthly------------------------------------------------------- '---------------------------------------populate monthly-------------------------------------------------------
@ -454,6 +463,30 @@ Sub load_mbox()
End Sub End Sub
Sub load_mbox_ann()
load_tb = True
tbBaseVol = Format(bVol, "#,###")
tbBaseVal = Format(bVal, "#,###")
tbBasePrice = Format(bPrc, "0.000")
tbPadjVol = Format(pVol, "#,###")
tbPadjVal = Format(pVal, "#,###")
tbPadjPrice = Format(pPrc, "0.000")
tbFcVol = Format(fVol, "#,###")
tbFcVal = Format(fVal, "#,###")
If Not set_Price Then tbFcPrice = Format(fPrc, "0.###")
tbAdjVol = Format(aVol, "#,###")
tbAdjVal = Format(aVal, "#,###")
tbAdjPrice = Format(aPrc, "0.000")
load_tb = False
End Sub
Sub load_array() Sub load_array()
'base 'base
@ -488,46 +521,53 @@ Sub calc_val()
Dim pchange As Double Dim pchange As Double
If IsNumeric(tbFcVal.value) Then If IsNumeric(tbFcVal.value) Then
'calculate percent change 'get textbox value
pchange = CDbl(tbFcVal.value) / (CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value)) fVal = tbFcVal.value
'do calculations
'plug the adjustment required aVal = fVal - bVal - pVal
tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###")
'---------if volume adjustment method is selected, scale the volume up---------------------------------- '---------if volume adjustment method is selected, scale the volume up----------------------------------
If opPlugVol Then If opPlugVol Then
tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)) * pchange, "#,###") pchange = fVal / (pVal + bVal)
fVol = (pVol + bVol) * pchange
Else Else
tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)), "#,###") fVol = pVol + bVol
End If End If
tbFcPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value), "#.000") If fVol = 0 Then
tbAdjVol = Format(tbFcVol - (CDbl(tbBaseVol) + CDbl(tbPadjVol)), "#,###") fPrc = 0
tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((CDbl(tbBaseVal.value) + CDbl(tbPadjVal.value)) / (CDbl(tbBaseVol.value) + CDbl(tbPadjVol.value))), "#.000")
Else Else
'tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value), "#,###") fPrc = fVal / fVol
tbAdjVol = Format((CDbl(tbFcVol.value) - CDbl(tbBaseVol.value) - CDbl(tbPadjVol.value)), "#,###")
tbAdjPrice = 0
'tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((tbBaseVal + tbPadjVal) / (tbBaseVol + tbPadjVol)), "#.000")
End If End If
tbFcVal = Format(CDbl(tbFcVal), "#,##0") aVol = fVol - (bVol + pVol)
aPrc = fPrc - (bPrc + pPrc)
Else
aVol = fVol - bVol - pVol
aPrc = 0
End If
tbFcVal = Format(tbFcVal, "#,###")
Me.load_mbox_ann
'build json 'build json
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("scenario")("version") = "b20"
adjust("scenario")("iter") = handler.basis
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName adjust("user") = Application.UserName
adjust("source") = "adj"
If opEditSales Then If opEditSales Then
If opPlugVol Then If opPlugVol Then
adjust("type") = "scale_v" adjust("type") = "scale_v"
adjust("amount") = tbAdjVal adjust("amount") = aVal
Else Else
adjust("type") = "scale_p" adjust("type") = "scale_p"
adjust("amount") = tbAdjVal adjust("amount") = aVal
End If End If
Else Else
adjust("type") = "scale_vp" adjust("type") = "scale_vp"
adjust("qty") = tbAdjVol adjust("qty") = aVol
adjust("amount") = tbAdjVal adjust("amount") = aVal
End If End If
'print json 'print json
@ -538,31 +578,46 @@ End Sub
Sub calc_price() Sub calc_price()
If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
tbFcVal = Format(CDbl(tbFcPrice.value) * CDbl(tbFcVol.value), "#,##0") 'capture currently changed item
tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###") fVol = tbFcVol.value
tbAdjVol = Format(tbFcVol - (CDbl(tbBaseVol) + CDbl(tbPadjVol)), "#,###") fPrc = tbFcPrice.value
tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((CDbl(tbBaseVal.value) + CDbl(tbPadjVal.value)) / (CDbl(tbBaseVol.value) + CDbl(tbPadjVol.value))), "#.000") 'calc
fVal = fPrc * fVol
aVal = fVal - bVal - pVal
aVol = fVol - (bVol + pVol)
If nomonth Then
aPrc = fVal / fVol - bPrc
Else Else
tbFcVal = 0 aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol))
tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###")
End If End If
Else
fVal = 0
aVal = fVal - bVal - pVal
End If
Me.load_mbox_ann
'build json 'build json
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName adjust("user") = Application.UserName
adjust("source") = "adj"
If opEditSales Then If opEditSales Then
If opPlugVol Then If opPlugVol Then
adjust("type") = "scale_v" adjust("type") = "scale_v"
adjust("amount") = tbAdjVal adjust("amount") = aVal
Else Else
adjust("type") = "scale_p" adjust("type") = "scale_p"
adjust("amount") = tbAdjVal adjust("amount") = aVal
End If End If
Else
If aVol = 0 Then
adjust("type") = "scale_p"
Else Else
adjust("type") = "scale_vp" adjust("type") = "scale_vp"
adjust("qty") = tbAdjVol End If
adjust("amount") = tbAdjVal adjust("qty") = aVol
adjust("amount") = aVal
End If End If
'print json 'print json
@ -594,7 +649,11 @@ Sub calc_mval()
fVolm = pVolm + bVolm fVolm = pVolm + bVolm
End If End If
End If End If
If fVolm = 0 Then
fPrcm = 0
Else
fPrcm = fValm / fVolm fPrcm = fValm / fVolm
End If
aVolm = fVolm - (bVolm + pVolm) aVolm = fVolm - (bVolm + pVolm)
aPrcm = fPrcm - (bPrcm + pPrcm) aPrcm = fPrcm - (bPrcm + pPrcm)
Else Else
@ -604,9 +663,13 @@ Sub calc_mval()
tbMFVal = Format(tbMFVal, "#,###") tbMFVal = Format(tbMFVal, "#,###")
'build json 'build json
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
j("scenario")("version") = "b20"
j("scenario")("iter") = handler.basis
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
j("user") = Application.UserName j("user") = Application.UserName
j("source") = "adj"
If opEditSalesM Then If opEditSalesM Then
If opmvol Then If opmvol Then
If nomonth Then If nomonth Then
@ -614,6 +677,7 @@ Sub calc_mval()
j("month") = month(mline, 0) j("month") = month(mline, 0)
Else Else
j("type") = "scale_v" j("type") = "scale_v"
j("scenario")("order_month") = month(mline, 0)
End If End If
j("amount") = aValm j("amount") = aValm
Else Else
@ -622,6 +686,7 @@ Sub calc_mval()
j("month") = month(mline, 0) j("month") = month(mline, 0)
Else Else
j("type") = "scale_p" j("type") = "scale_p"
j("scenario")("order_month") = month(mline, 0)
End If End If
j("amount") = aValm j("amount") = aValm
End If End If
@ -631,6 +696,7 @@ Sub calc_mval()
j("month") = month(mline, 0) j("month") = month(mline, 0)
Else Else
j("type") = "scale_vp" j("type") = "scale_vp"
j("scenario")("order_month") = month(mline, 0)
End If End If
j("qty") = aVolm j("qty") = aVolm
j("amount") = aValm j("amount") = aValm
@ -668,8 +734,11 @@ Sub calc_mprice()
'build json 'build json
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
j("scenario")("version") = "b20"
j("scenario")("iter") = handler.basis
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
j("user") = Application.UserName j("user") = Application.UserName
j("source") = "adj"
If opEditSalesM Then If opEditSalesM Then
If opmvol Then If opmvol Then
If nomonth Then If nomonth Then
@ -677,6 +746,7 @@ Sub calc_mprice()
j("month") = month(mline, 0) j("month") = month(mline, 0)
Else Else
j("type") = "scale_v" j("type") = "scale_v"
j("scenario")("order_month") = month(mline, 0)
End If End If
j("amount") = aValm j("amount") = aValm
Else Else
@ -686,6 +756,7 @@ Sub calc_mprice()
j("month") = month(mline, 0) j("month") = month(mline, 0)
Else Else
j("type") = "scale_p" j("type") = "scale_p"
j("scenario")("order_month") = month(mline, 0)
End If End If
j("amount") = aValm j("amount") = aValm
End If End If
@ -693,9 +764,14 @@ Sub calc_mprice()
If nomonth Then If nomonth Then
j("type") = "addmonth_vp" j("type") = "addmonth_vp"
j("month") = month(mline, 0) j("month") = month(mline, 0)
Else
If aVolm = 0 Then
j("type") = "scale_p"
Else Else
j("type") = "scale_vp" j("type") = "scale_vp"
End If End If
j("scenario")("order_month") = month(mline, 0)
End If
j("qty") = aVolm j("qty") = aVolm
j("amount") = aValm j("amount") = aValm
End If End If
@ -709,3 +785,27 @@ Sub calc_mprice()
Me.load_array Me.load_array
End Sub End Sub
Function iter_def(ByVal iter As String) As String
Dim i As Integer
For i = 0 To UBound(handler.baseline)
If handler.baseline(i) = iter Then
iter_def = "baseline"
Exit Function
End If
Next i
For i = 0 To UBound(handler.adjust)
If handler.adjust(i) = iter Then
iter_def = "adjust"
Exit Function
End If
Next i
iter_def = "exclude"
End Function

BIN
fpvt.frx

Binary file not shown.

View File

@ -11,6 +11,9 @@ Public data() As String
Public agg() As String Public agg() As String
Public showprice As Boolean Public showprice As Boolean
Public server As String Public server As String
Public basis() As Variant
Public baseline() As Variant
Public adjust() As Variant
Sub load_fpvt() Sub load_fpvt()
@ -85,7 +88,7 @@ Sub pg_main_workset(rep As String)
doc = "{""quota_rep"":""" & rep & """}" doc = "{""quota_rep"":""" & rep & """}"
With req With req
.Open "GET", server & "/get_pool", True .Open "GET", handler.server & "/get_pool", True
.SetRequestHeader "Content-Type", "application/json" .SetRequestHeader "Content-Type", "application/json"
.Send doc .Send doc
.WaitForResponse .WaitForResponse
@ -191,29 +194,7 @@ Sub pull_rep()
End Sub End Sub
Sub test()
Dim req As New WinHttp.WinHttpRequest
Dim json As Object
Dim wr As String
With req
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
'.Open "GET", "http://10.56.1.15:3000/scenario_package", True
.Open "GET", "http://localhost:3000/scenario_package", True
.SetRequestHeader "Content-Type", "application/json"
.Send handler.scenario
.WaitForResponse
wr = .ResponseText
End With
Set json = JsonConverter.ParseJson(wr)
'Set scenario_totals = json
End Sub
Function request_adjust(doc As String) As Object Function request_adjust(doc As String) As Object
@ -227,17 +208,30 @@ Function request_adjust(doc As String) As Object
Set json = JsonConverter.ParseJson(doc) Set json = JsonConverter.ParseJson(doc)
With req With req
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True .Open "POST", server & "/" & json("type"), True
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
.Open "GET", "http://192.168.1.69:3000/" & json("type"), True
.SetRequestHeader "Content-Type", "application/json" .SetRequestHeader "Content-Type", "application/json"
.Send doc .Send doc
.WaitForResponse .WaitForResponse
wr = .ResponseText wr = .ResponseText
End With End With
If Mid(wr, 2, 5) = "error" Then
MsgBox (wr)
Exit Function
End If
If Mid(wr, 1, 6) = "<body>" Then
MsgBox (wr)
Exit Function
End If
Set json = JsonConverter.ParseJson(wr) 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) ReDim res(json("x").Count - 1, 32)
For i = 1 To UBound(res, 1) + 1 For i = 1 To UBound(res, 1) + 1
@ -300,3 +294,42 @@ Function request_adjust(doc As String) As Object
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
End Function 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

51
openf.frm Normal file
View File

@ -0,0 +1,51 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf
Caption = "Open a Forecast"
ClientHeight = 2025
ClientLeft = 120
ClientTop = 465
ClientWidth = 3825
OleObjectBlob = "openf.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "openf"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cbCancel_Click()
openf.Hide
End Sub
Private Sub cbOK_Click()
Application.StatusBar = "Retrieving data for " & cbDSM.value & "....."
openf.Caption = "retrieving data......"
Call handler.pg_main_workset(cbDSM.value)
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
Application.StatusBar = False
openf.Hide
End Sub
Private Sub UserForm_Activate()
'handler.server = "http://192.168.1.69:3000"
handler.server = Sheets("config").Cells(1, 2)
Dim x As New TheBigOne
Dim d() As String
openf.Caption = "Select a DSM"
d = x.SHTp_Get("reps", 1, 1, True)
For i = 1 To UBound(d, 2)
Call cbDSM.AddItem(d(0, i))
Next i
End Sub

BIN
openf.frx Normal file

Binary file not shown.