VBA/months.cls

780 lines
22 KiB
OpenEdge ABL
Raw Normal View History

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "months"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private x As New TheBigOne
Private units() As Variant
Private price() As Variant
Private sales() As Variant
Private tunits() As Variant
Private tprice() As Variant
Private tsales() As Variant
Private dumping As Boolean
Private vedit As String
Private adjust() As Object
Private jtext() As Variant
Private basejson As Object
2019-03-18 15:29:40 -04:00
Private rollback As Boolean
2019-03-19 01:03:43 -04:00
Private scenario() As Variant
Private orig As Range
2019-03-19 15:43:31 -04:00
Private basket_touch As Range
2019-03-19 16:46:56 -04:00
Private showbasket As Boolean
Private Sub Worksheet_Change(ByVal target As Range)
If Not dumping Then
If Not Intersect(target, Range("A1:R18")) Is Nothing Then
If target.Columns.Count > 1 Then
MsgBox ("you can only change one column at a time - your change will be undone")
dumping = True
Application.Undo
dumping = False
Exit Sub
2019-03-19 15:43:31 -04:00
End If
End If
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("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("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("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Set basket_touch = target
2019-03-19 15:43:31 -04:00
Call Me.get_edit_basket
Set basket_touch = Nothing
2019-03-19 15:43:31 -04:00
End If
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
2019-03-19 16:46:56 -04:00
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Cancel = True
Call Me.basket_pick(target)
target.Select
End If
2019-03-19 16:46:56 -04:00
End Sub
2019-03-20 01:43:18 -04:00
Sub picker_shortcut()
Attribute picker_shortcut.VB_ProcData.VB_Invoke_Func = "I\n14"
If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Call Me.basket_pick(Selection)
2019-03-20 01:43:18 -04:00
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Cancel = True
Call Me.basket_pick(target)
target.Select
End If
2019-03-19 01:03:43 -04:00
End Sub
Public Function rev_cust(cust As String) As String
If cust = "" Then
rev_cust = ""
Exit Function
End If
If InStr(1, cust, " - ") <= 9 Then
rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(left(cust, 8))
Else
rev_cust = trim(right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - "))
End If
End Function
Sub mvp_set()
Dim i As Integer
Call Me.get_sheet
For i = 1 To 12
If units(i, 5) = "" Then units(i, 5) = 0
If price(i, 5) = "" Then price(i, 5) = 0
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
sales(i, 5) = units(i, 5) * price(i, 5)
2019-03-19 01:03:43 -04:00
If units(i, 4) = 0 And price(i, 4) = 0 Then
sales(i, 4) = 0
Else
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
End If
2019-03-15 16:42:27 -04:00
Call Me.build_json(i)
Next i
Me.crunch_array
Me.set_sheet
End Sub
Sub mvp_adj()
Dim i As Integer
Call Me.get_sheet
For i = 1 To 12
If units(i, 4) = "" Then units(i, 4) = 0
If price(i, 4) = "" Then price(i, 4) = 0
units(i, 5) = units(i, 4) + (units(i, 2) + units(i, 3))
price(i, 5) = price(i, 4) + (price(i, 2) + price(i, 3))
sales(i, 5) = units(i, 5) * price(i, 5)
2019-03-19 01:03:43 -04:00
If units(i, 4) = 0 And price(i, 4) = 0 Then
sales(i, 4) = 0
Else
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
End If
2019-03-15 16:42:27 -04:00
Call Me.build_json(i)
Next i
Me.crunch_array
Me.set_sheet
End Sub
Sub ms_set()
2019-03-20 01:43:18 -04:00
On Error GoTo errh
Dim i As Integer
Call Me.get_sheet
2019-03-18 15:29:40 -04:00
Dim vp As String
vp = Sheets("month").Range("R2")
For i = 1 To 12
2019-03-19 01:03:43 -04:00
If sales(i, 5) = "" Then sales(i, 5) = 0
2019-03-20 01:43:18 -04:00
If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 2) <> Round(sales(i, 4), 2) Then
2019-03-18 15:29:40 -04:00
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
Select Case vp
Case "volume"
If co_num(price(i, 5), 0) = 0 Then
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
dumping = True
Application.Undo
dumping = False
Exit Sub
End If
'reset price to original - delete these lines if a cascading effect is desired
'price(i, 4) = 0
'price(i, 5) = price(i, 2) + price(i, 3)
'calc volume change on original price
units(i, 5) = sales(i, 5) / price(i, 5)
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
Case "price"
If co_num(units(i, 5), 0) = 0 Then
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
dumping = True
Application.Undo
dumping = False
Exit Sub
End If
price(i, 5) = sales(i, 5) / units(i, 5)
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
Case Else
MsgBox ("error forcing sales with no offset specified - your change will be undone")
dumping = True
Application.Undo
dumping = False
Exit Sub
End Select
End If
Call Me.build_json(i)
Next i
Me.crunch_array
Me.set_sheet
2019-03-20 01:43:18 -04:00
errh:
If Err.Number <> 0 Then rollback = True
2019-03-18 15:29:40 -04:00
End Sub
Sub ms_adj()
Dim i As Integer
Call Me.get_sheet
Dim vp As String
vp = Sheets("month").Range("R2")
For i = 1 To 12
2019-03-19 01:03:43 -04:00
If sales(i, 4) = "" Then sales(i, 4) = 0
2019-03-18 15:29:40 -04:00
If Round(sales(i, 5), 6) <> Round(sales(i, 2) + sales(i, 3) + sales(i, 4), 6) Then
sales(i, 5) = sales(i, 4) + sales(i, 2) + sales(i, 3)
Select Case vp
Case "volume"
If co_num(price(i, 5), 0) = 0 Then
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
dumping = True
Application.Undo
dumping = False
Exit Sub
End If
'reset price to original
'price(i, 4) = 0
'price(i, 5) = price(i, 2) + price(i, 3)
'calc volume change on original price
units(i, 5) = sales(i, 5) / price(i, 5)
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
Case "price"
If co_num(units(i, 5), 0) = 0 Then
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
dumping = True
Application.Undo
dumping = False
Exit Sub
End If
price(i, 5) = sales(i, 5) / units(i, 5)
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
Case Else
MsgBox ("error forcing sales with no offset specified - your change will be undone")
dumping = True
Application.Undo
dumping = False
Exit Sub
End Select
End If
Call Me.build_json(i)
Next i
2019-03-18 15:29:40 -04:00
Me.crunch_array
Me.set_sheet
End Sub
Sub get_sheet()
Dim i As Integer
units = Range("B6:F17")
price = Range("H6:L17")
sales = Range("N6:R17")
tunits = Range("B18:F18")
tprice = Range("H18:L18")
tsales = Range("N18:R18")
ReDim adjust(12)
2019-03-20 01:43:18 -04:00
Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
End Sub
Sub set_sheet()
2019-03-15 16:42:27 -04:00
Dim i As Integer
2019-03-15 16:42:27 -04:00
dumping = True
Range("B6:F17") = units
Range("H6:L17") = price
Range("N6:R17") = sales
2019-03-15 16:42:27 -04:00
Range("B18:F18").FormulaR1C1 = tunits
Range("H18:L18").FormulaR1C1 = tprice
Range("N18:R18").FormulaR1C1 = tsales
2019-03-19 10:57:56 -04:00
Range("T6:U18").ClearContents
2019-03-19 16:46:56 -04:00
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
2019-03-19 15:43:31 -04:00
'Sheets("month").Range("B32:Q5000").ClearContents
2019-03-15 16:42:27 -04:00
For i = 1 To 12
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
Next i
2019-03-19 01:03:43 -04:00
dumping = False
End Sub
2019-03-15 10:44:45 -04:00
Sub load_sheet()
units = Sheets("_month").Range("A2:E13").FormulaR1C1
price = Sheets("_month").Range("F2:J13").FormulaR1C1
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
2019-03-19 01:03:43 -04:00
scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
2019-03-15 16:42:27 -04:00
tunits = Range("B18:F18")
tprice = Range("H18:L18")
tsales = Range("N18:R18")
2019-03-19 15:43:31 -04:00
'reset basket
2019-03-20 12:47:01 -04:00
Sheets("_month").Range("U1:X10000").ClearContents
2019-03-19 15:43:31 -04:00
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
2019-03-15 16:42:27 -04:00
ReDim adjust(12)
Call Me.crunch_array
Call Me.set_sheet
Call Me.print_basket
2019-03-19 01:03:43 -04:00
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_grey(ByRef target As Range)
With target.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.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)
2019-03-20 01:43:18 -04:00
Dim i As Long
Dim j As Long
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)
2019-03-15 16:42:27 -04:00
'if something is changing
2019-03-19 01:03:43 -04:00
If Round(units(pos, 4), 2) <> 0 Or (Round(price(pos, 4), 8) <> 0 And Round(units(pos, 5), 2) <> 0) Then
2019-03-18 15:29:40 -04:00
Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
2019-03-15 16:42:27 -04:00
'if there is no existing volume on the target month but units are being added
If units(pos, 2) + units(pos, 3) = 0 And units(pos, 4) <> 0 Then
'add month
If Round(price(pos, 5), 8) <> Round(tprice(1, 2) + tprice(1, 3), 8) Then
'if the target price is diferent from the average and a month is being added
adjust(pos)("type") = "addmonth_vp"
Else
'if the target price is the same as average and a month is being added
adjust(pos)("type") = "addmonth_v"
End If
2019-03-20 01:43:18 -04:00
adjust(pos)("month") = Worksheets("month").Cells(5 + pos, 1)
2019-03-15 16:42:27 -04:00
adjust(pos)("qty") = units(pos, 4)
adjust(pos)("amount") = sales(pos, 4)
Else
'scale the existing volume(price) on the target month
If Round(price(pos, 4), 8) <> 0 Then
2019-03-20 01:43:18 -04:00
If Round(units(pos, 4), 2) <> 0 Then
adjust(pos)("type") = "scale_vp"
Else
adjust(pos)("type") = "scale_p"
End If
2019-03-15 16:42:27 -04:00
Else
'if the target price is the same as average and a month is being added
adjust(pos)("type") = "scale_v"
End If
adjust(pos)("qty") = units(pos, 4)
adjust(pos)("amount") = sales(pos, 4)
'------------add this in to only scale a particular month--------------------
adjust(pos)("scenario")("order_month") = Worksheets("month").Cells(5 + pos, 1)
End If
2019-03-20 01:43:18 -04:00
adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
adjust(pos)("user") = Application.UserName
adjust(pos)("scenario")("version") = "b20"
adjust(pos)("scenario")("iter") = handler.basis
adjust(pos)("source") = "adj"
End If
End Sub
Sub crunch_array()
Dim i As Integer
2019-03-15 16:42:27 -04:00
Dim j 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
2019-03-15 16:42:27 -04:00
For j = 1 To 5
tunits(1, j) = tunits(1, j) + units(i, j)
tsales(1, j) = tsales(1, j) + sales(i, j)
Next j
Next i
2019-03-15 10:44:45 -04:00
'prior
If tunits(1, 1) = 0 Then
tprice(1, 1) = 0
Else
tprice(1, 1) = tsales(1, 1) / tunits(1, 1)
End If
'base
If tunits(1, 2) = 0 Then
tprice(1, 2) = 0
Else
tprice(1, 2) = tsales(1, 2) / tunits(1, 2)
End If
'forecast
2019-03-18 15:29:40 -04:00
If tunits(1, 5) <> 0 Then
tprice(1, 5) = tsales(1, 5) / tunits(1, 5)
Else
tprice(1, 5) = 0
End If
'adjust
2019-03-20 01:43:18 -04:00
If (tunits(1, 2) + tunits(1, 3)) = 0 Then
tprice(1, 3) = 0
Else
tprice(1, 3) = (tsales(1, 2) + tsales(1, 3)) / (tunits(1, 2) + tunits(1, 3)) - tprice(1, 2)
End If
'current adjust
2019-03-15 16:42:27 -04:00
tprice(1, 4) = tprice(1, 5) - (tprice(1, 2) + tprice(1, 3))
2019-03-15 10:44:45 -04:00
End Sub
2019-03-18 15:29:40 -04:00
2019-03-20 01:43:18 -04:00
Sub Cancel()
2019-03-18 15:29:40 -04:00
Sheets("Orders").Select
End Sub
Sub reset()
2019-03-18 15:29:40 -04:00
Call Me.load_sheet
End Sub
2019-03-19 01:03:43 -04:00
2019-03-20 12:47:01 -04:00
Sub switch_basket()
Attribute switch_basket.VB_ProcData.VB_Invoke_Func = " \n14"
2019-03-19 01:03:43 -04:00
2019-03-19 16:46:56 -04:00
If Sheets("config").Cells(6, 2) = 1 Then
Sheets("config").Cells(6, 2) = 0
2019-03-20 12:47:01 -04:00
Else
Sheets("config").Cells(6, 2) = 1
2019-03-19 16:46:56 -04:00
End If
2019-03-20 12:47:01 -04:00
Call Me.print_basket
2019-03-19 15:43:31 -04:00
End Sub
Sub print_basket()
2019-03-20 12:47:01 -04:00
'Sheets("config").Cells(6, 2) = 1
If Sheets("config").Cells(6, 2) = 0 Then
dumping = True
Worksheets("month").Range("B32:Q10000").ClearContents
Rows("20:31").Hidden = False
dumping = False
Exit Sub
End If
Dim i As Long
Dim basket() As Variant
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
dumping = True
Worksheets("month").Range("B32:Q10000").ClearContents
For i = 1 To UBound(basket, 1)
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
Sheets("month").Cells(31 + i, 6) = basket(i, 2)
Sheets("month").Cells(31 + i, 12) = basket(i, 3)
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
Next i
Rows("20:31").Hidden = True
dumping = False
2019-03-19 15:43:31 -04:00
End Sub
Sub basket_pick(ByRef target As Range)
Attribute basket_pick.VB_ProcData.VB_Invoke_Func = "I\n14"
2019-03-19 15:43:31 -04:00
Dim i As Long
build.part = Sheets("month").Cells(target.row, 2)
build.bill = rev_cust(Sheets("month").Cells(target.row, 6))
build.ship = rev_cust(Sheets("month").Cells(target.row, 12))
build.useval = False
build.Show
If build.useval Then
dumping = True
'if an empty row is selected, force it to be the next open slot
If Sheets("month").Cells(target.row, 2) = "" Then
Do Until Sheets("month").Cells(target.row + i, 2) <> ""
i = i - 1
Loop
i = i + 1
End If
Sheets("month").Cells(target.row + i, 2) = build.cbPart.value
Sheets("month").Cells(target.row + i, 6) = rev_cust(build.cbBill.value)
Sheets("month").Cells(target.row + i, 12) = rev_cust(build.cbShip.value)
dumping = False
Set basket_touch = Selection
Call Me.get_edit_basket
Set basket_touch = Nothing
End If
2019-03-20 12:47:01 -04:00
target.Select
2019-03-19 15:43:31 -04:00
End Sub
Sub get_edit_basket()
Dim i As Long
Dim b() As Variant
Dim mix As Double
Dim touch_mix As Double
2019-03-19 16:46:56 -04:00
Dim untouched As Long
2019-03-19 15:43:31 -04:00
Dim touch() As Boolean
'ReDim b(basket_rows, 3)
i = 0
Do Until Worksheets("month").Cells(33 + i, 2) = ""
i = i + 1
Loop
i = i - 1
ReDim b(i, 3)
ReDim touch(i)
2019-03-19 16:46:56 -04:00
untouched = i + 1
2019-03-19 15:43:31 -04:00
i = 0
mix = 0
Do Until Worksheets("month").Cells(33 + i, 2) = ""
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
If b(i, 3) = "" Then b(i, 3) = 0
mix = mix + b(i, 3)
If Not Intersect(basket_touch, Worksheets("month").Cells(33 + i, 17)) Is Nothing Then
touch_mix = touch_mix + b(i, 3)
touch(i) = True
2019-03-19 16:46:56 -04:00
untouched = untouched - 1
2019-03-19 15:43:31 -04:00
End If
i = i + 1
Loop
'evaluate mix changes and force to 100
For i = 0 To UBound(b, 1)
If Not touch(i) Then
2019-03-19 16:46:56 -04:00
If mix - touch_mix = 0 Then
b(i, 3) = (1 - mix) / untouched
Else
b(i, 3) = b(i, 3) + b(i, 3) * (1 - mix) / (mix - touch_mix)
End If
2019-03-19 15:43:31 -04:00
End If
Next i
2019-03-19 01:03:43 -04:00
2019-03-19 15:43:31 -04:00
dumping = True
2019-03-19 01:03:43 -04:00
2019-03-19 15:43:31 -04:00
'put the mix plug back on the the sheet
For i = 0 To UBound(b, 1)
Worksheets("month").Cells(33 + i, 17) = b(i, 3)
Next i
2019-03-19 01:03:43 -04:00
dumping = False
2019-03-19 15:43:31 -04:00
Worksheets("_month").Range("U2:X5000").ClearContents
2019-03-19 16:46:56 -04:00
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
2019-03-20 01:43:18 -04:00
'orig.Select
2019-03-19 16:46:56 -04:00
2019-03-19 15:43:31 -04:00
2019-03-19 01:03:43 -04:00
End Sub
2019-03-19 15:43:31 -04:00
2019-03-20 01:43:18 -04:00
Sub post_adjust()
Dim i As Long
For i = 2 To 13
If Sheets("_month").Cells(i, 16) <> "" Then
Call handler.request_adjust(Sheets("_month").Cells(i, 16))
End If
Next i
Sheets("Orders").Select
Worksheets("month").Visible = xlHidden
End Sub
Sub build_new()
Worksheets("config").Cells(5, 2) = 1
Dim i As Long
Dim j As Long
Dim basket() As Variant
Dim m() As Variant
dumping = True
m = Sheets("_month").Range("A2:O13").FormulaR1C1
For i = 1 To UBound(m, 1)
For j = 1 To UBound(m, 2)
m(i, j) = 0
Next j
Next i
Worksheets("_month").Range("A2:O13") = m
Worksheets("_month").Range("U2:X1000").ClearContents
Worksheets("_month").Range("Z2:AC1000").ClearContents
Worksheets("_month").Range("R2:S1000").ClearContents
Call Me.load_sheet
'Call Me.set_sheet
'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
Sheets("month").Cells(32, 2) = basket(1, 1)
Sheets("month").Cells(32, 6) = basket(1, 2)
Sheets("month").Cells(32, 12) = basket(1, 3)
Sheets("month").Cells(32, 17) = basket(1, 4)
Call Me.print_basket
dumping = False
End Sub