From f5a60c7b7c605333e31f96591d0fbb326896ed4d Mon Sep 17 00:00:00 2001 From: Trowbridge Date: Wed, 20 Mar 2019 12:07:35 -0400 Subject: [PATCH] refactor basket edits, div by zero, build new --- months.cls | 343 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 205 insertions(+), 138 deletions(-) diff --git a/months.cls b/months.cls index 41ad231..8c793ec 100644 --- a/months.cls +++ b/months.cls @@ -27,101 +27,12 @@ Private orig As Range Private basket_touch As Range Private showbasket As Boolean +Private Sub Worksheet_Change(ByVal target As Range) - -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) - - 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 - - 'Call Me.set_format - +End Sub + +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 - tprice(1, 1) = tsales(1, 1) / tunits(1, 1) + If tunits(1, 1) = 0 Then + tprice(1, 1) = 0 + Else + tprice(1, 1) = tsales(1, 1) / tunits(1, 1) + End If 'base - tprice(1, 2) = tsales(1, 2) / tunits(1, 2) + 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,15 +623,77 @@ Sub show_basket() End Sub -Sub part_list() - - parts.Show +Sub print_basket() + + 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" - build.Show + 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 @@ -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