refactor basket edits, div by zero, build new
This commit is contained in:
Trowbridge
parent
ddbc3d0fd2
commit
f5a60c7b7c
331
months.cls
331
months.cls
@ -27,101 +27,12 @@ Private orig As Range
|
||||
Private basket_touch As Range
|
||||
Private showbasket As Boolean
|
||||
|
||||
|
||||
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
||||
|
||||
Dim i As Long
|
||||
Dim b() As Variant
|
||||
|
||||
Cancel = True
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then
|
||||
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
|
||||
Target.Select
|
||||
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Public Function rev_cust(cust As String) As String
|
||||
|
||||
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
|
||||
|
||||
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
|
||||
|
||||
Dim i As Long
|
||||
Dim b() As Variant
|
||||
|
||||
Cancel = True
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then
|
||||
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
|
||||
Target.Select
|
||||
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
|
||||
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
|
||||
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
|
||||
@ -130,30 +41,69 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
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("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 Then
|
||||
Set basket_touch = Target
|
||||
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||
Set basket_touch = target
|
||||
Call Me.get_edit_basket
|
||||
Set basket_touch = Nothing
|
||||
End If
|
||||
|
||||
|
||||
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'Call Me.set_format
|
||||
Private Sub Worksheet_BeforeDoubleClick(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
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
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)
|
||||
End If
|
||||
Selection.Select
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
@ -345,17 +295,12 @@ Sub set_sheet()
|
||||
Range("N18:R18").FormulaR1C1 = tsales
|
||||
Range("T6:U18").ClearContents
|
||||
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
||||
|
||||
'Sheets("month").Range("B32:Q5000").ClearContents
|
||||
|
||||
For i = 1 To 12
|
||||
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
||||
Next i
|
||||
|
||||
If showbasket Then
|
||||
Call Me.show_basket
|
||||
End If
|
||||
|
||||
dumping = False
|
||||
|
||||
End Sub
|
||||
@ -373,8 +318,9 @@ Sub load_sheet()
|
||||
'reset basket
|
||||
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
|
||||
ReDim adjust(12)
|
||||
Me.crunch_array
|
||||
Me.set_sheet
|
||||
Call Me.crunch_array
|
||||
Call Me.set_sheet
|
||||
Call Me.print_basket
|
||||
|
||||
|
||||
|
||||
@ -464,9 +410,9 @@ Sub set_border(ByRef targ As Range)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub fill_yellow(ByRef Target As Range)
|
||||
Sub fill_yellow(ByRef target As Range)
|
||||
|
||||
With Target.Interior
|
||||
With target.Interior
|
||||
.Pattern = xlSolid
|
||||
.PatternColorIndex = xlAutomatic
|
||||
.ThemeColor = xlThemeColorAccent4
|
||||
@ -476,9 +422,22 @@ Sub fill_yellow(ByRef Target As Range)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub fill_none(ByRef Target As Range)
|
||||
Sub fill_grey(ByRef target As Range)
|
||||
|
||||
With Target.Interior
|
||||
|
||||
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
|
||||
@ -486,15 +445,15 @@ Sub fill_none(ByRef Target As Range)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub format_price(ByRef Target As Range)
|
||||
Sub format_price(ByRef target As Range)
|
||||
|
||||
Target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
||||
target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
||||
|
||||
End Sub
|
||||
|
||||
Sub format_number(ByRef Target As Range)
|
||||
Sub format_number(ByRef target As Range)
|
||||
|
||||
Target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
||||
target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
||||
|
||||
End Sub
|
||||
|
||||
@ -543,6 +502,8 @@ Sub build_json(ByVal pos As Integer)
|
||||
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
|
||||
adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
|
||||
adjust(pos)("user") = Application.UserName
|
||||
@ -572,9 +533,17 @@ Sub crunch_array()
|
||||
Next i
|
||||
|
||||
'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
|
||||
If tunits(1, 5) <> 0 Then
|
||||
tprice(1, 5) = tsales(1, 5) / tunits(1, 5)
|
||||
@ -601,26 +570,24 @@ End Sub
|
||||
|
||||
Sub reset()
|
||||
|
||||
|
||||
Call Me.load_sheet
|
||||
If showbasket Then
|
||||
showbasket = False
|
||||
Else
|
||||
showbasket = True
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Sub show_basket()
|
||||
Attribute show_basket.VB_ProcData.VB_Invoke_Func = " \n14"
|
||||
|
||||
|
||||
If showbasket Then
|
||||
showbasket = False
|
||||
If Sheets("config").Cells(6, 2) = 1 Then
|
||||
Sheets("config").Cells(6, 2) = 0
|
||||
dumping = True
|
||||
Worksheets("month").Range("B32:Q10000").ClearContents
|
||||
Rows("20:31").Hidden = False
|
||||
dumping = False
|
||||
Exit Sub
|
||||
End If
|
||||
showbasket = True
|
||||
Sheets("config").Cells(6, 2) = 1
|
||||
|
||||
Dim i As Long
|
||||
Dim basket() As Variant
|
||||
@ -656,16 +623,78 @@ Sub show_basket()
|
||||
|
||||
End Sub
|
||||
|
||||
Sub part_list()
|
||||
Sub print_basket()
|
||||
|
||||
parts.Show
|
||||
Sheets("config").Cells(6, 2) = 1
|
||||
Dim i As Long
|
||||
Dim basket() As Variant
|
||||
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
|
||||
|
||||
dumping = True
|
||||
|
||||
'Application.ScreenUpdating = False
|
||||
|
||||
'Set orig = Selection
|
||||
|
||||
'ActiveWindow.FreezePanes = False
|
||||
|
||||
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:20").Select
|
||||
'ActiveWindow.FreezePanes = True
|
||||
|
||||
'Rows("20:31").Select
|
||||
'Selection.EntireRow.Hidden = True
|
||||
Rows("20:31").Hidden = True
|
||||
'orig.Select
|
||||
|
||||
'Application.ScreenUpdating = True
|
||||
|
||||
dumping = False
|
||||
|
||||
End Sub
|
||||
|
||||
Sub basket_pick()
|
||||
|
||||
Sub basket_pick(ByRef target As Range)
|
||||
Attribute basket_pick.VB_ProcData.VB_Invoke_Func = "I\n14"
|
||||
|
||||
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
|
||||
Sheets("month").Select
|
||||
|
||||
End Sub
|
||||
|
||||
Sub get_edit_basket()
|
||||
@ -751,3 +780,41 @@ Sub post_adjust()
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user