add formatting and start work on calcing a grand total

This commit is contained in:
Paul Trowbridge 2019-03-15 15:53:32 -04:00
parent a444e3a08b
commit 5dce331355
3 changed files with 197 additions and 11 deletions

BIN
fpvt.frx

Binary file not shown.

View File

@ -336,10 +336,14 @@ End Sub
Sub month_tosheet(ByRef pkg() As Variant) Sub month_tosheet(ByRef pkg() As Variant)
Dim j As Object
Dim i As Integer Dim i As Integer
Dim sh As Worksheet Dim sh As Worksheet
Set sh = Sheets("_month") Set sh = Sheets("_month")
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
For i = 0 To 12 For i = 0 To 12
'------------volume------------------- '------------volume-------------------
sh.Cells(i + 1, 1) = co_num(pkg(i, 1), 0) sh.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
@ -401,7 +405,12 @@ Sub month_tosheet(ByRef pkg() As Variant)
Else Else
sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4) sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
End If End If
'--json--
sh.Cells(i + 1, 16) = JsonConverter.ConvertToJson(j)
End If End If
Next i Next i
End Sub End Sub

View File

@ -13,8 +13,15 @@ Private x As New TheBigOne
Private units() As Variant Private units() As Variant
Private price() As Variant Private price() As Variant
Private sales() As Variant Private sales() As Variant
Private tunits() As Variant
Private tprice() As Variant
Private tsales() As Variant
Private dumping As Boolean Private dumping As Boolean
Private vedit As String Private vedit As String
Private adjust() As Object
Private jtext() As Variant
Private basejson As Object
Private Sub Worksheet_Activate() Private Sub Worksheet_Activate()
@ -22,19 +29,22 @@ Private Sub Worksheet_Activate()
End Sub End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Private Sub Worksheet_Change(ByVal target As Range)
Application.Calculation = xlCalculationManual
If Not dumping Then If Not dumping Then
If Not Intersect(Target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
If Not Intersect(Target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set If Not Intersect(target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
If Not Intersect(Target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj If Not Intersect(target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
If Not Intersect(Target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set If Not Intersect(target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
'If Not Intersect(Target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj 'If Not Intersect(Target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
'If Not Intersect(Target, Range("R6:R17")) Is Nothing Then Call Me.ms_set 'If Not Intersect(Target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
End If End If
'Call Me.set_format
Application.Calculation = xlCalculationAutomatic
End Sub End Sub
@ -55,7 +65,8 @@ Sub mvp_set()
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3)) sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
Next i Next i
set_sheet Me.crunch_array
Me.set_sheet
End Sub End Sub
@ -74,7 +85,8 @@ Sub mvp_adj()
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3)) sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
Next i Next i
set_sheet Me.crunch_array
Me.set_sheet
End Sub End Sub
@ -99,9 +111,16 @@ End Sub
Sub get_sheet() Sub get_sheet()
Dim i As Integer
units = Range("B6:F17") units = Range("B6:F17")
price = Range("H6:L17") price = Range("H6:L17")
sales = Range("N6:R17") sales = Range("N6:R17")
tunits = Range("B18:F18")
tprice = Range("H18:L18")
tsales = Range("N18:R18")
ReDim adjust(12)
Set basejson = JsonConverter.ParseJson("{""scenario"":" & Sheets("_month").Range("P1").FormulaR1C1 & "}")
End Sub End Sub
@ -119,11 +138,169 @@ End Sub
Sub load_sheet() Sub load_sheet()
units = Sheets("_month").Range("A2:e13").FormulaR1C1 units = Sheets("_month").Range("A2:E13").FormulaR1C1
price = Sheets("_month").Range("F2:j13").FormulaR1C1 price = Sheets("_month").Range("F2:J13").FormulaR1C1
sales = Sheets("_month").Range("K2:o13").FormulaR1C1 sales = Sheets("_month").Range("K2:O13").FormulaR1C1
Call Me.set_sheet
End Sub
Sub set_format()
Dim prices As Range
Dim price_adj As Range
Dim price_set As Range
Dim vol As Range
Dim vol_adj As Range
Dim vol_set As Range
Dim val As Range
Dim val_adj As Range
Dim val_set As Range
Set prices = Sheets("month").Range("H6:L17")
Set price_adj = Sheets("month").Range("K6:K17")
Set price_set = Sheets("month").Range("L6:L17")
Set vol = Sheets("month").Range("B6:F17")
Set vol_adj = Sheets("month").Range("E6:E17")
Set vol_set = Sheets("month").Range("F6:F17")
Set val = Sheets("month").Range("N6:R17")
Set val_adj = Sheets("month").Range("Q6:Q17")
Set val_set = Sheets("month").Range("R6:R17")
Call Me.format_price(prices)
Call Me.set_border(prices)
Call Me.fill_yellow(price_adj)
Call Me.fill_none(price_set)
Call Me.format_number(vol)
Call Me.set_border(vol)
Call Me.fill_yellow(vol_adj)
Call Me.fill_none(vol_set)
Call Me.format_number(val)
Call Me.set_border(val)
Call Me.fill_yellow(val_adj)
Call Me.fill_none(val_set)
End Sub
Sub set_border(ByRef targ As Range)
targ.Borders(xlDiagonalDown).LineStyle = xlNone
targ.Borders(xlDiagonalUp).LineStyle = xlNone
With targ.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With targ.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With targ.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With targ.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With targ.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With targ.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Sub fill_yellow(ByRef target As Range)
With target.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub fill_none(ByRef target As Range)
With target.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub format_price(ByRef target As Range)
target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
End Sub
Sub format_number(ByRef target As Range)
target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
End Sub
Sub build_json(ByVal pos As Integer)
'if there is no existing volume on the target month
If units(pos, 2) + units(pos, 3) = 0 Then
'add month
If price(pos, 4) = 0 Then
'if the target price is diferent from the average
adjust(pos)("type") = "addmonth_vd"
End If
End If
End Sub
Sub crunch_array()
Dim i As Integer
For i = 1 To 5
tunits(1, i) = 0
tprice(1, i) = 0
tsales(1, i) = 0
Next i
For i = 1 To 12
tunits(1, 1) = tunits(1, 1) + units(i, 1)
tsales(1, 1) = tsales(1, 1) + sales(i, 1)
Next i
'prior
tprice(1, 1) = tsales(1, 1) / tunits(1, 1)
'base
tprice(2, 1) = tsales(2, 1) / tunits(2, 1)
'forecast
tprice(5, 1) = tsales(5, 1) / tunits(5, 1)
'adjust
tprice(3, 1) = (tsales(2, 1) + tsales(3, 1)) / (tunits(2, 1) + tunits(3, 1)) - tprice(2, 1)
'current adjust
tprice(4, 1) = tprice(5, 1) - (tprice(2, 1) + tprice(3, 1))
End Sub End Sub