refactor basket edits, div by zero, build new

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 Not Intersect(target, Range("A1:R18")) Is Nothing Then
-            If Target.Columns.Count > 1 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("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
-        If Not Intersect(Target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
+            Set basket_touch = target
-        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
             Call Me.get_edit_basket
+            Set basket_touch = Nothing
         End If
         
+    End If
+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
 
-    'Call Me.set_format
+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
+    Call Me.crunch_array
-    Me.set_sheet
+    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
+    If Sheets("config").Cells(6, 2) = 1 Then
-        showbasket = False
+        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()
+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()
 
-    build.Show
+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
 
@@ -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