rebuild monthly controls

This commit is contained in:
Trowbridge 2019-03-06 04:25:25 -05:00
parent 856c885c44
commit bbf3d84e60
2 changed files with 212 additions and 95 deletions

307
fpvt.frm
View File

@ -17,6 +17,37 @@ Public mod_adjust As Boolean
Private month() As Variant
Private mload() As Variant
Private adjust As Object
Private nomonth As Boolean
Private mline As Integer
Private clear_lb As Boolean
Private load_tb As Boolean
Private set_Price As Boolean
Private bVol As Double
Private bVal As Double
Private bPrc As Double
Private pVol As Double
Private pVal As Double
Private pPrc As Double
Private aVol As Double
Private aVal As Double
Private aPrc As Double
Private fVol As Double
Private fVal As Double
Private fPrc As Double
Private bVolm As Double
Private bValm As Double
Private bPrcm As Double
Private pVolm As Double
Private pValm As Double
Private pPrcm As Double
Private aVolm As Double
Private aValm As Double
Private aPrcm As Double
Private fVolm As Double
Private fValm As Double
Private fPrcm As Double
Option Explicit
@ -55,47 +86,31 @@ Private Sub butMCancel_Click()
End Sub
Private Sub lbMonth_Change()
If clear_lb Or load_tb Then Exit Sub
Dim i As Long
For i = 0 To 12
For i = 0 To 13
If lbMonth.Selected(i) Then
If i <> 0 Then
If co_num(month(i, 6), 0) = 0 And co_num(month(i, 2), 0) = 0 Then
tbMBaseVal.value = 0
tbMBaseVol.value = 0
tbmPAVal.value = 0
tbMPAVol.value = 0
tbMFVal.value = 0
tbMFVol.value = 0
tbMBasePrice = 0
tbMFPrice = 0
End If
'------------base-------------------------------------
tbMBaseVal.value = co_num(month(i, 6), 0)
tbMBaseVol.value = co_num(month(i, 2), 0)
tbmPAVal.value = co_num(month(i, 7), 0)
tbMPAVol.value = co_num(month(i, 3), 0)
tbMFVal.value = co_num(month(i, 8), 0)
tbMFVol.value = co_num(month(i, 4), 0)
If tbMBaseVol <> 0 Then
tbMBasePrice = Format(tbMBaseVal / tbMBaseVol, "#.000")
Else
tbMBasePrice = 0
End If
If tbMFVol <> 0 Then
tbMFPrice = Format(tbMFVal / tbMFVol, "#.000")
Else
tbMFPrice = 0
End If
If i <> 0 And i <> 13 Then
mline = i
Me.load_var
Me.load_mbox
Else
tbMBaseVal.value = 0
tbMBaseVol.value = 0
tbmPAVal.value = 0
tbMPAVol.value = 0
tbMFVal.value = 0
tbMFVol.value = 0
tbMBasePrice = 0
tbMFPrice = 0
load_tb = True
tbMBaseVal.value = ""
tbMBaseVol.value = ""
tbMBasePrice.value = ""
tbmPAVal.value = ""
tbMPAVol.value = ""
tbMPAPrice.value = ""
tbMFVal.value = ""
tbMFVol.value = ""
tbMFPrice.value = ""
tbMAVal.value = ""
tbMAVol.value = ""
tbMAPrice.value = ""
load_tb = False
End If
Exit For
End If
@ -216,22 +231,26 @@ End Sub
'--------------------------------monthly buttons--------------------------------------
Private Sub opmPrice_Click()
calc_mval
'calc_mval
End Sub
Private Sub opmVol_Click()
calc_mval
'calc_mval
End Sub
Private Sub tbmfPrice_Change()
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
set_Price = True
If opEditPriceM Then calc_mprice
set_Price = False
End Sub
Private Sub tbmfVal_Change()
If opEditSalesM Then calc_mval
End Sub
Private Sub tbmfVol_Change()
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
If opEditPriceM Then calc_mprice
End Sub
@ -286,22 +305,27 @@ Private Sub UserForm_Activate()
k = 0
'--parse json into variant array for loading--
ReDim month(sp("package")("mpvt").Count, 8)
ReDim month(sp("package")("mpvt").Count + 1, 10)
For i = 1 To sp("package")("mpvt").Count
month(i, 0) = sp("package")("mpvt")(i)("order_month")
month(i, 1) = Format(sp("package")("mpvt")(i)("2019 qty"), "#,###")
month(i, 2) = Format(sp("package")("mpvt")(i)("2020 base qty"), "#,###")
month(i, 3) = Format(sp("package")("mpvt")(i)("2020 adj qty"), "#,###")
month(i, 4) = Format(sp("package")("mpvt")(i)("2020 tot qty"), "#,###")
month(i, 5) = Format(sp("package")("mpvt")(i)("2019 value_usd"), "#,###")
month(i, 6) = Format(sp("package")("mpvt")(i)("2020 base value_usd"), "#,###")
month(i, 7) = Format(sp("package")("mpvt")(i)("2020 adj value_usd"), "#,###")
month(i, 8) = Format(sp("package")("mpvt")(i)("2020 tot value_usd"), "#,###")
month(i, 1) = sp("package")("mpvt")(i)("2019 qty")
month(i, 2) = sp("package")("mpvt")(i)("2020 base qty")
month(i, 3) = sp("package")("mpvt")(i)("2020 adj qty")
month(i, 4) = sp("package")("mpvt")(i)("2020 tot qty")
month(i, 5) = sp("package")("mpvt")(i)("2019 value_usd")
month(i, 6) = sp("package")("mpvt")(i)("2020 base value_usd")
month(i, 7) = sp("package")("mpvt")(i)("2020 adj value_usd")
month(i, 8) = sp("package")("mpvt")(i)("2020 tot value_usd")
If co_num(month(i, 2), 0) = 0 Then
month(i, 9) = "addmonth"
Else
month(i, 9) = "scale"
End If
Next i
month(0, 0) = "month"
month(13, 0) = "total"
month(0, 1) = "2019 qty"
month(0, 2) = "2020 base qty"
month(0, 3) = "2020 adj qty"
@ -311,24 +335,130 @@ Private Sub UserForm_Activate()
month(0, 7) = "2020 adj val"
month(0, 8) = "2020 val"
ReDim mload(UBound(month, 1), 5)
For i = 0 To UBound(month, 1)
mload(i, 0) = month(i, 0)
mload(i, 1) = month(i, 1)
mload(i, 2) = month(i, 4)
mload(i, 3) = month(i, 5)
mload(i, 4) = month(i, 8)
Next i
lbMonth.list = mload
lbMonth.ColumnCount = 8
'MsgBox (lbMonth.list(0, 0))
Me.crunch_array
Application.StatusBar = False
End Sub
Sub crunch_array()
Dim i As Integer
month(13, 1) = 0
month(13, 2) = 0
month(13, 3) = 0
month(13, 4) = 0
month(13, 5) = 0
month(13, 6) = 0
month(13, 7) = 0
month(13, 8) = 0
For i = 1 To 12
month(13, 1) = month(13, 1) + co_num(month(i, 1), 0)
month(13, 2) = month(13, 2) + co_num(month(i, 2), 0)
month(13, 3) = month(13, 3) + co_num(month(i, 3), 0)
month(13, 4) = month(13, 4) + co_num(month(i, 4), 0)
month(13, 5) = month(13, 5) + co_num(month(i, 5), 0)
month(13, 6) = month(13, 6) + co_num(month(i, 6), 0)
month(13, 7) = month(13, 7) + co_num(month(i, 7), 0)
month(13, 8) = month(13, 8) + co_num(month(i, 8), 0)
Next i
ReDim mload(UBound(month, 1), 5)
For i = 0 To UBound(month, 1)
mload(i, 0) = Format(month(i, 0), "#,###")
mload(i, 1) = Format(month(i, 1), "#,###")
mload(i, 2) = Format(month(i, 4), "#,###")
mload(i, 3) = Format(month(i, 5), "#,###")
mload(i, 4) = Format(month(i, 8), "#,###")
Next i
'mline = 0
clear_lb = True
lbMonth.clear
lbMonth.list = mload
clear_lb = False
End Sub
Sub load_var()
'base
bVolm = co_num(month(mline, 2), 0)
bValm = co_num(month(mline, 6), 0)
'prior adjust
pVolm = co_num(month(mline, 3), 0)
pValm = co_num(month(mline, 7), 0)
'current forecast
fVolm = co_num(month(mline, 4), 0)
fValm = co_num(month(mline, 8), 0)
'adjustment
aVolm = fVolm - (bVolm + pVolm)
aValm = fValm - (bValm + pValm)
If month(mline, 9) = "addmonth" Then
nomonth = True
bPrcm = month(13, 6) / month(13, 2)
fPrcm = month(13, 8) / month(13, 4)
Else
'prices
If bVolm <> 0 Then bPrcm = bValm / bVolm
If (bVolm + pVolm) <> 0 Then pPrcm = (pValm + bValm) / (bVolm + pVolm) - bPrcm
If fVolm <> 0 Then fPrcm = fValm / fVolm
aPrcm = fPrcm - (bPrcm + pPrcm)
End If
End Sub
Sub load_mbox()
load_tb = True
tbMBaseVol = Format(bVolm, "#,###")
tbMBaseVal = Format(bValm, "#,###")
tbMBasePrice = Format(bPrcm, "0.000")
tbMPAVol = Format(pVolm, "#,###")
tbmPAVal = Format(pValm, "#,###")
tbMPAPrice = Format(pPrcm, "0.000")
tbMFVol = Format(fVolm, "#,###")
tbMFVal = Format(fValm, "#,###")
If Not set_Price Then tbMFPrice = Format(fPrcm, "0.###")
tbMAVol = Format(aVolm, "#,###")
tbMAVal = Format(aValm, "#,###")
tbMAPrice = Format(aPrcm, "0.000")
load_tb = False
End Sub
Sub load_array()
'base
month(mline, 2) = bVolm
month(mline, 6) = bValm
'prior adjust
month(mline, 3) = pVolm
month(mline, 7) = pValm
'current forecast
month(mline, 4) = fVolm
month(mline, 8) = fValm
Me.crunch_array
End Sub
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
If one = "" Or IsNull(one) Then
@ -460,38 +590,25 @@ End Sub
Sub calc_mprice()
If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 And IsNumeric(tbMFVol.value) And tbMFVol.value <> 0 Then
tbMFVal = Format(CDbl(tbMFPrice.value) * CDbl(tbMFVol.value), "#,##0")
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###")
tbMAVol = Format(tbMFVol - (CDbl(tbMBaseVol) + CDbl(tbMPAVol)), "#,###")
tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbmPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000")
'capture currently changed item
fVolm = tbMFVol.value
fPrcm = tbMFPrice.value
'calc
fValm = fPrcm * fVolm
aValm = fValm - bValm - pValm
aVolm = fVolm - (bVolm + pVolm)
If nomonth Then
aPrcm = fValm / fVolm - bPrcm
Else
aPrcm = fValm / fVolm - ((bValm + pValm) / (bVolm + pVolm))
End If
Else
tbMFVal = 0
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###")
fValm = 0
aValm = fValm - bValm - pValm
End If
End Sub
Sub calc_mvol()
Dim pchange As Double
If clear_lb Then MsgBox ("clear")
Me.load_mbox
Me.load_array
If IsNumeric(tbMFVol.value) And tbMFVol <> 0 Then
'price should already have been re-calculated to base + prior at this point
tbMFVal = Format(CDbl(tbMFPrice.value) * CDbl(tbMFVol.value))
'calculate percent change
'pchange = CDbl(tbMFVal.value) / (CDbl(tbMPAVal.value) + CDbl(tbMBaseVal.value))
'plug the adjustment required
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###")
tbMAVol = Format(tbMFVol - (CDbl(tbMBaseVol) + CDbl(tbMPAVol)), "#,###")
tbMAPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value) - ((CDbl(tbMBaseVal.value) + CDbl(tbmPAVal.value)) / (CDbl(tbMBaseVol.value) + CDbl(tbMPAVol.value))), "#.000")
Else
tbMFVal = 0
tbMAVal = Format(CDbl(tbMFVal.value) - CDbl(tbMBaseVal.value) - CDbl(tbmPAVal.value), "#,###")
tbMAPrice = Format((tbMBaseVal + tbmPAVal) / (tbMBaseVol + tbMPAVol), "#.000")
tbMAVol = Format(-CDbl(tbMBaseVol.value) - CDbl(tbMPAVol.value), "#,###")
End If
tbMFVol = Format(CDbl(tbMFVol), "#,###")
End Sub

BIN
fpvt.frx

Binary file not shown.