number of updates for monthly

fpvt.frm

@@ -4,7 +4,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
    ClientHeight    =   7260
    ClientLeft      =   120
    ClientTop       =   465
-   ClientWidth     =   16140
+   ClientWidth     =   17475
    OleObjectBlob   =   "fpvt.frx":0000
    StartUpPosition =   1  'CenterOwner
 End
@@ -101,6 +101,7 @@ End Sub
 Private Sub cbGoSheet_Click()
 
     Me.Hide
+    Worksheets("month").Visible = xlSheetVisible
     Sheets("month").Select
 
 End Sub
@@ -328,8 +329,16 @@ Private Sub UserForm_Activate()
     
     fVol = bVol + pVol
     fVal = bVal + pVal
-    fPrc = fVal / fVol
+    If fVol = 0 Then
-    pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
+        fPrc = 0
+    Else
+        fPrc = fVal / fVol
+    End If
+    If (bVol + pVol) = 0 Then
+        pPrc = 0
+    Else
+        pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
+    End If
     Me.load_mbox_ann
     
     '---------------------------------------populate monthly-------------------------------------------------------

handler.bas

@@ -89,6 +89,7 @@ Sub pg_main_workset(rep As String)
     doc = "{""quota_rep"":""" & rep & """}"
          
     With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
         .Open "GET", handler.server & "/get_pool", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
@@ -207,6 +208,7 @@ Function request_adjust(doc As String) As Object
     Dim str() As String
     
     Set json = JsonConverter.ParseJson(doc)
+    server = Sheets("config").Cells(1, 2)
     
     With req
         .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
@@ -389,7 +391,11 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
             If co_num(pkg(i, 3), 0) = 0 Then
                 sh.Cells(i + 1, 8) = 0
             Else
-                sh.Cells(i + 1, 8) = pkg(i, 7) / pkg(i, 3) - pkg(i, 6) / pkg(i, 2)
+                If (pkg(i, 3) + pkg(i, 2)) = 0 Then
+                    sh.Cells(i + 1, 8) = 0
+                Else
+                    sh.Cells(i + 1, 8) = (pkg(i, 7) + pkg(i, 6)) / (pkg(i, 3) + pkg(i, 2)) - (pkg(i, 6) / pkg(i, 2))
+                End If
             End If
             
             '--current adjust--

months.cls

@@ -29,12 +29,12 @@ Private showbasket As Boolean
 
 
 
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
+Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
     Dim i As Long
     Dim b() As Variant
 
-    cancel = True
+    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))
@@ -56,10 +56,10 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean
             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)
-            'Sheets("month").Cells.Rows(Target.row + i).Select
             dumping = False
             Set basket_touch = Selection
             Call Me.get_edit_basket
+            Target.Select
             
         End If
         
@@ -77,6 +77,44 @@ Public Function rev_cust(cust As String) As String
 
 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)
 
     
@@ -100,6 +138,8 @@ Private Sub Worksheet_Change(ByVal Target As Range)
         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
@@ -166,6 +206,8 @@ End Sub
 
 Sub ms_set()
 
+On Error GoTo errh
+
     Dim i As Integer
     Call Me.get_sheet
     Dim vp As String
@@ -173,7 +215,7 @@ Sub ms_set()
 
     For i = 1 To 12
         If sales(i, 5) = "" Then sales(i, 5) = 0
-        If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 6) <> Round(sales(i, 4), 6) Then
+        If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 2) <> Round(sales(i, 4), 2) Then
             sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
             Select Case vp
                 Case "volume"
@@ -213,6 +255,9 @@ Sub ms_set()
     
     Me.crunch_array
     Me.set_sheet
+
+errh:
+    If Err.Number <> 0 Then rollback = True
     
         
 End Sub
@@ -282,7 +327,7 @@ Sub get_sheet()
     tprice = Range("H18:L18")
     tsales = Range("N18:R18")
     ReDim adjust(12)
-    Set basejson = JsonConverter.ParseJson("{""scenario"":" & Sheets("_month").Range("P1").FormulaR1C1 & "}")
+    Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
       
 End Sub
 
@@ -455,6 +500,19 @@ End Sub
 
 Sub build_json(ByVal pos As Integer)
 
+    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)
+
     'if something is changing
     If Round(units(pos, 4), 2) <> 0 Or (Round(price(pos, 4), 8) <> 0 And Round(units(pos, 5), 2) <> 0) Then
         Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
@@ -468,13 +526,17 @@ Sub build_json(ByVal pos As Integer)
                 'if the target price is the same as average and a month is being added
                 adjust(pos)("type") = "addmonth_v"
             End If
+            adjust(pos)("month") = Worksheets("month").Cells(5 + pos, 1)
             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
-                'if the target price is diferent from the average and a month is being added
+                If Round(units(pos, 4), 2) <> 0 Then
-                adjust(pos)("type") = "scale_vp"
+                    adjust(pos)("type") = "scale_vp"
+                Else
+                    adjust(pos)("type") = "scale_p"
+                End If
             Else
                 'if the target price is the same as average and a month is being added
                 adjust(pos)("type") = "scale_v"
@@ -482,6 +544,11 @@ Sub build_json(ByVal pos As Integer)
             adjust(pos)("qty") = units(pos, 4)
             adjust(pos)("amount") = sales(pos, 4)
         End If
+        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
@@ -515,14 +582,18 @@ Sub crunch_array()
         tprice(1, 5) = 0
     End If
     'adjust
-    tprice(1, 3) = (tsales(1, 2) + tsales(1, 3)) / (tunits(1, 2) + tunits(1, 3)) - tprice(1, 2)
+    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
     tprice(1, 4) = tprice(1, 5) - (tprice(1, 2) + tprice(1, 3))
     
 
 End Sub
 
-Sub cancel()
+Sub Cancel()
 
     Sheets("Orders").Select
 
@@ -531,7 +602,11 @@ End Sub
 Sub reset()
 
     Call Me.load_sheet
-
+    If showbasket Then
+        showbasket = False
+    Else
+        showbasket = True
+    End If
     
 End Sub
 
@@ -654,9 +729,25 @@ Sub get_edit_basket()
     Worksheets("_month").Range("U2:X5000").ClearContents
     Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
     
+    'orig.Select
     
     
     
 
 End Sub
 
+
+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