get monthly changes working

This commit is contained in:
Paul Trowbridge 2019-03-19 10:57:56 -04:00
parent 9b8a486981
commit 6a34f3fcf4
4 changed files with 8 additions and 6 deletions

BIN
fpvt.frx

Binary file not shown.

View File

@ -413,6 +413,7 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
Next i Next i
'scenario 'scenario
Sheets("_month").Range("R1:S1000").ClearContents
For i = 0 To UBound(handler.sc, 1) For i = 0 To UBound(handler.sc, 1)
sh.Cells(i + 1, 18) = handler.sc(i, 0) sh.Cells(i + 1, 18) = handler.sc(i, 0)
sh.Cells(i + 1, 19) = handler.sc(i, 1) sh.Cells(i + 1, 19) = handler.sc(i, 1)

View File

@ -240,6 +240,7 @@ Sub set_sheet()
Range("B18:F18").FormulaR1C1 = tunits Range("B18:F18").FormulaR1C1 = tunits
Range("H18:L18").FormulaR1C1 = tprice Range("H18:L18").FormulaR1C1 = tprice
Range("N18:R18").FormulaR1C1 = tsales Range("N18:R18").FormulaR1C1 = tsales
Range("T6:U18").ClearContents
Range("T6:U18").FormulaR1C1 = scenario Range("T6:U18").FormulaR1C1 = scenario
Sheets("month").Range("B32:Q5000").ClearContents Sheets("month").Range("B32:Q5000").ClearContents
@ -490,10 +491,10 @@ Sub show_basket()
For i = 1 To UBound(basket, 1) - 1 For i = 1 To UBound(basket, 1) - 1
Sheets("month").Cells(32 + i, 2) = basket(i + 1, 1) Sheets("month").Cells(31 + i, 2) = basket(i, 1)
Sheets("month").Cells(32 + i, 6) = basket(i + 1, 2) Sheets("month").Cells(31 + i, 6) = basket(i, 2)
Sheets("month").Cells(32 + i, 12) = basket(i + 1, 3) Sheets("month").Cells(31 + i, 12) = basket(i, 3)
Sheets("month").Cells(32 + i, 17) = basket(i + 1, 4) Sheets("month").Cells(31 + i, 17) = basket(i, 4)
Next i Next i
Rows("20:20").Select Rows("20:20").Select

View File

@ -9,7 +9,7 @@ Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True Attribute VB_Exposed = True
Option Explicit Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
If Intersect(target, ActiveSheet.Range("b7:v100000")) Is Nothing Then If Intersect(target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
Exit Sub Exit Sub
@ -21,7 +21,7 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean
Exit Sub Exit Sub
End If End If
Cancel = True cancel = True
Dim i As Long Dim i As Long
Dim j As Long Dim j As Long