pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

save changes through forecast v0.5

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

206
fpvt.frm
View File

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

Binary file not shown.

85
handler.bas
View File

@ -11,6 +11,9 @@ 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()
@ -85,7 +88,7 @@ Sub pg_main_workset(rep As String)
doc = "{""quota_rep"":""" & rep & """}"
With req
.Open "GET", server & "/get_pool", True
.Open "GET", handler.server & "/get_pool", True
.SetRequestHeader "Content-Type", "application/json"
.Send doc
.WaitForResponse
@ -191,29 +194,7 @@ Sub pull_rep()
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
@ -227,17 +208,30 @@ Function request_adjust(doc As String) As Object
Set json = JsonConverter.ParseJson(doc)
With req
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
.Open "GET", "http://192.168.1.69:3000/" & json("type"), True
.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) = "<body>" 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
@ -300,3 +294,42 @@ Function request_adjust(doc As String) As Object
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

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
View File

Binary file not shown.