save work

fpvt.frm

@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt 
    Caption         =   "Forecast Adjustment"
-   ClientHeight    =   7275
+   ClientHeight    =   7260
    ClientLeft      =   120
    ClientTop       =   465
-   ClientWidth     =   13695
+   ClientWidth     =   16140
    OleObjectBlob   =   "fpvt.frx":0000
    StartUpPosition =   1  'CenterOwner
 End
@@ -14,11 +14,10 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 Public mod_adjust As Boolean
-Public month() As Variant
+Private month() As Variant
+Private mload() As Variant
 Option Explicit
 
-
-
 Private Sub cbCancel_Click()
 
     tbAdjVol.value = 0
@@ -45,6 +44,73 @@ Private Sub chbPlug_Change()
 End Sub
 
 
+Private Sub lbMonth_Change()
+    
+    Dim i As Long
+    For i = 0 To 12
+        If lbMonth.Selected(i) Then
+            If i <> 0 Then
+                '------------base-------------------------------------
+                tbMBaseVal.value = co_num(month(i, 6), 0)
+                tbMBaseVol.value = co_num(month(i, 2), 0)
+                tbmPAVal.value = co_num(month(i, 7), 0)
+                tbMPAVol.value = co_num(month(i, 3), 0)
+                tbMFVal.value = co_num(month(i, 8), 0)
+                tbMFVol.value = co_num(month(i, 4), 0)
+                If tbMBaseVol <> 0 Then
+                    tbMBasePrice = Format(tbMBaseVal / tbMBaseVol, "#.000")
+                Else
+                    tbMBasePrice = 0
+                End If
+                If tbMFVol <> 0 Then
+                    tbMFPrice = Format(tbMFVal / tbMFVol, "#.000")
+                Else
+                    tbMFPrice = 0
+                End If
+            Else
+                tbMBaseVal.value = 0
+                tbMBaseVol.value = 0
+                tbmPAVal.value = 0
+                tbMPAVol.value = 0
+                tbMFVal.value = 0
+                tbMFVol.value = 0
+                tbMBasePrice = 0
+                tbMFPrice = 0
+            End If
+            Exit For
+        End If
+    Next i
+    
+    
+    
+End Sub
+
+
+Private Sub ListBox1_Click()
+
+End Sub
+
+Private Sub opmprice_Click()
+    
+    tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###")
+    tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###")
+    tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
+    
+End Sub
+
+Private Sub opmvol_Click()
+
+    Dim pchange As Double
+
+    '---------calculate percent change----------------------------------------------------------------------
+    pchange = 1 + CDbl(tbMAVal.value) / (CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value))
+    '---------add the adjustments together to get the new forecast------------------------------------------
+    tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###")
+    tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###")
+    tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
+
+End Sub
+
 Private Sub opprice_Click()
 
     tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value) + CDbl(tbAdjVal.value), "#,###")
@@ -101,12 +167,41 @@ Private Sub tbAdjVol_Change()
 
 End Sub
 
+Private Sub tbMAVal_Change()
+
+    Dim pchange As Double
+    
+    If IsNumeric(tbMAVal.value) Then
+        '---------calculate percent change----------------------------------------------------------------------
+        pchange = 1 + CDbl(tbMAVal.value) / (CDbl(tbMAVal.value) + CDbl(tbMBaseVal.value))
+        '---------add the adjustments together to get the new forecast------------------------------------------
+        tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###")
+        '---------if volume adjustment method is selected, scale the volume up----------------------------------
+        If opmvol Then
+            tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###")
+        Else
+            tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###")
+        End If
+        tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
+    Else
+        tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value), "#,###")
+        tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###")
+        tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
+    End If
+
+End Sub
+
 Private Sub UserForm_Activate()
     
     Dim sp As Object
     Dim i As Long
+    Dim j As Long
+    Dim k As Long
     Dim ok As Boolean
     
+    handler.server = "http://10.56.1.20:3000"
+    'handler.server = "http://192.168.1.69:3000"
+
     Set sp = handler.scenario_package(handler.scenario, ok)
     
     If Not ok Then
@@ -142,10 +237,59 @@ Private Sub UserForm_Activate()
     
     '---------------------------------------populate monthly-------------------------------------------------------
     
+    k = 0
     '--parse json into variant array for loading--
+    ReDim month(sp("package")("mpvt").Count, 8)
+        
+    For i = 1 To sp("package")("mpvt").Count
+        month(i, 0) = sp("package")("mpvt")(i)("order_month")
+        month(i, 1) = Format(sp("package")("mpvt")(i)("2019 qty"), "#,###")
+        month(i, 2) = Format(sp("package")("mpvt")(i)("2020 base qty"), "#,###")
+        month(i, 3) = Format(sp("package")("mpvt")(i)("2020 adj qty"), "#,###")
+        month(i, 4) = Format(sp("package")("mpvt")(i)("2020 tot qty"), "#,###")
+        month(i, 5) = Format(sp("package")("mpvt")(i)("2019 value_usd"), "#,###")
+        month(i, 6) = Format(sp("package")("mpvt")(i)("2020 base value_usd"), "#,###")
+        month(i, 7) = Format(sp("package")("mpvt")(i)("2020 adj value_usd"), "#,###")
+        month(i, 8) = Format(sp("package")("mpvt")(i)("2020 tot value_usd"), "#,###")
+        
+    Next i
     
     
+    month(0, 0) = "month"
+    month(0, 1) = "2019 qty"
+    month(0, 2) = "2020 base qty"
+    month(0, 3) = "2020 adj qty"
+    month(0, 4) = "2020 qty"
+    month(0, 5) = "2019 val"
+    month(0, 6) = "2020 base val"
+    month(0, 7) = "2020 adj val"
+    month(0, 8) = "2020 val"
+    
+    ReDim mload(UBound(month, 1), 5)
+    For i = 0 To UBound(month, 1)
+        mload(i, 0) = month(i, 0)
+        mload(i, 1) = month(i, 1)
+        mload(i, 2) = month(i, 4)
+        mload(i, 3) = month(i, 5)
+        mload(i, 4) = month(i, 8)
+    Next i
+    
+    lbMonth.list = mload
+    lbMonth.ColumnCount = 8
+    
+    'MsgBox (lbMonth.list(0, 0))
      
     Application.StatusBar = False
     
 End Sub
+
+Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
+
+    If one = "" Or IsNull(one) Then
+        co_num = two
+    Else
+        co_num = one
+    End If
+
+End Function
+

handler.bas

@@ -9,11 +9,12 @@ Public wapi As New Windows_API
 Public data() As String
 Public agg() As String
 Public showprice As Boolean
+Public server As String
 
 
 Sub load_fpvt()
 
-    fpvt.sbEdit.SimpleText = "retrieving data.........."
+    Application.StatusBar = "retrieving selection data....."
     
     'data = x.SHTp_Get("data", 1, 1, True)
     'Call x.TBLp_Aggregate(data, True, True, True, Array(1, 3), Array("S", "S"), Array(30))
@@ -34,39 +35,21 @@ Sub load_fpvt()
     If showprice Then
         fpvt.opvolume.Visible = False
         fpvt.opprice.Visible = False
-        'fpvt.tbBasePrice.BackColor = &H80000005
-        'fpvt.tbBaseVol.BackColor = &H80000005
         fpvt.tbAdjPrice.BackColor = &H80000005
         fpvt.tbAdjVol.BackColor = &H80000005
         fpvt.tbAdjVal.BackColor = &H80000004
         fpvt.tbAdjVal.Enabled = False
-        'fpvt.tbFcPrice.BackColor = &H80000005
-        'fpvt.tbFcVol.BackColor = &H80000005
-        'enabled
-        'fpvt.tbBasePrice.Enabled = True
-        'fpvt.tbBaseVol.Enabled = True
         fpvt.tbAdjPrice.Enabled = True
         fpvt.tbAdjVol.Enabled = True
-        'fpvt.tbFcPrice.Enabled = True
-        'fpvt.tbFcVol.Enabled = True
     Else
         fpvt.opvolume.Visible = True
         fpvt.opprice.Visible = True
-        'fpvt.tbBasePrice.BackColor = &H80000003
-        'fpvt.tbBaseVol.BackColor = &H80000003
         fpvt.tbAdjPrice.BackColor = &H80000003
         fpvt.tbAdjVol.BackColor = &H80000003
         fpvt.tbAdjVal.BackColor = &H80000005
         fpvt.tbAdjVal.Enabled = True
-        'fpvt.tbFcPrice.BackColor = &H80000003
-        'fpvt.tbFcVol.BackColor = &H80000003
-        'enabled
-        'fpvt.tbBasePrice.Enabled = False
-        'fpvt.tbBaseVol.Enabled = False
         fpvt.tbAdjPrice.Enabled = False
         fpvt.tbAdjVol.Enabled = False
-        'fpvt.tbFcPrice.Enabled = False
-        'fpvt.tbFcVol.Enabled = False
     End If
     
     
@@ -78,70 +61,16 @@ Sub load_fpvt()
 
 End Sub
 
-
+Function request_adjust(doc As String) As Object
-Sub pull_months(doc As String)
-
-    Dim req As New WinHttp.WinHttpRequest
-    Dim wapi As New Windows_API
-    Dim wr As String
-    Dim json As Object
-    Dim i As Long
-    
-         
-         
-    With req
-        '.Open "GET", "http://10.56.1.108:3000/monthly_orders", True
-        .Open "GET", "http://192.168.1.69:3000/monthly_orders", True
-        .SetRequestHeader "Content-Type", "application/json"
-        .Send doc
-        .WaitForResponse
-        wr = .ResponseText
-    End With
-
-    Call wapi.ClipBoard_SetData(wr)
-    
-    'MsgBox (wr)
-    
-    On Error GoTo jerr
-    
-    Set json = JsonConverter.ParseJson(wr)
-    
-jerr:
-    If Err.Number <> 0 Then
-        MsgBox ("function call error:" & vbCrLf & wr)
-        Exit Sub
-    End If
-    
-    On Error GoTo errh
-    
-    Sheets("test").range("A2:D1000").ClearContents
-    Sheets("test").range("N3:Q14").ClearContents
-    
-    For i = 1 To json("jsonb_agg").Count
-        Sheets("test").Cells(i + 1, 1) = json("jsonb_agg")(i)("oseas")
-        Sheets("test").Cells(i + 1, 2) = json("jsonb_agg")(i)("monthn")
-        Sheets("test").Cells(i + 1, 3) = json("jsonb_agg")(i)("qty")
-        Sheets("test").Cells(i + 1, 4) = json("jsonb_agg")(i)("sales")
-    Next i
-    
-    Sheets("test").Select
-    
-errh:
-    If Err.Number <> 0 Then
-        MsgBox (Err.Description)
-    End If
-        
-End Sub
-
-Function scenario_totals(doc As String) As Object
 
     Dim req As New WinHttp.WinHttpRequest
     Dim json As Object
     Dim wr As String
     
     With req
-        '.Open "GET", "http://10.56.1.15:3000/get_pool", True
+        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
-        .Open "GET", "http://localhost:3000/scenario_totals", True
+        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
+        .Open "GET", "http://localhost:3000/request_adjust", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
         .WaitForResponse
@@ -153,7 +82,71 @@ Function scenario_totals(doc As String) As Object
     
 End Function
 
-Sub pg_main_workset()
+
+
+Function scenario_totals(doc As String, ByRef status As Boolean) As Object
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    
+    On Error GoTo errh
+    
+    With req
+        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
+        .Open "GET", "http://10.56.1.15:3000/scenario_totals", True
+        '.Open "GET", "http://localhost:3000/scenario_totals", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+    Set scenario_totals = json
+    
+errh:
+    If Err.Number <> 0 Then
+        status = False
+        MsgBox (Err.Description)
+        Set scenario_totals = Nothing
+    Else
+        status = True
+    End If
+    
+End Function
+
+Function scenario_package(doc As String, ByRef status As Boolean) As Object
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    
+    On Error GoTo errh
+    
+    With req
+        .Open "GET", server & "/scenario_package", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send doc
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+    Set scenario_package = json
+    
+errh:
+    If Err.Number <> 0 Then
+        status = False
+        MsgBox (Err.Description)
+        Set scenario_package = Nothing
+    Else
+        status = True
+    End If
+    
+End Function
+
+Sub pg_main_workset(rep As String)
 
     Dim req As New WinHttp.WinHttpRequest
     Dim wapi As New Windows_API
@@ -165,11 +158,10 @@ Sub pg_main_workset()
     Dim res() As Variant
     Dim str() As String
     
-    doc = "{""quota_rep"":""90005 - MARK WILKINSON""}"
+    doc = "{""quota_rep"":""" & rep & """}"
          
     With req
-        '.Open "GET", "http://10.56.1.15:3000/get_pool", True
+        .Open "GET", server & "/get_pool", True
-        .Open "GET", "http://192.168.1.69:3000/get_pool", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
         .WaitForResponse
@@ -179,7 +171,7 @@ Sub pg_main_workset()
     Set json = JsonConverter.ParseJson(wr)
     ReDim res(json("x").Count, 32)
     
-    For i = 1 To UBound(res, 1) - 1
+    For i = 1 To UBound(res, 1)
         res(i, 0) = json("x")(i)("bill_cust_descr")
         res(i, 1) = json("x")(i)("billto_group")
         res(i, 2) = json("x")(i)("ship_cust_descr")
@@ -267,3 +259,33 @@ Sub pg_main_workset()
     Call x.SHTp_Dump(str, "data", 1, 1, True, False, 28, 29, 30, 31, 32)
 
 End Sub
+
+Sub pull_rep()
+
+    openf.Show
+
+End Sub
+
+Sub test()
+
+    Dim req As New WinHttp.WinHttpRequest
+    Dim json As Object
+    Dim wr As String
+    
+
+    
+    With req
+        '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
+        '.Open "GET", "http://10.56.1.15:3000/scenario_package", True
+        .Open "GET", "http://localhost:3000/scenario_package", True
+        .SetRequestHeader "Content-Type", "application/json"
+        .Send handler.scenario
+        .WaitForResponse
+        wr = .ResponseText
+    End With
+
+    Set json = JsonConverter.ParseJson(wr)
+    'Set scenario_totals = json
+
+
+End Sub

pivot.bas

@@ -1,8 +1,8 @@
 Option Explicit
 
-Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean)
+Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
-    If Intersect(Target, ActiveSheet.range("b11:v100000")) Is Nothing Then
+    If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
         Exit Sub
     End If
     
@@ -12,7 +12,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean
         Exit Sub
     End If
 
-
     Cancel = True
 
     Dim i As Long
@@ -31,9 +30,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean
     Dim pi As PivotItem
     Dim wapi As New Windows_API
     
-    
-    
-    
     Set ri = Target.Cells.PivotCell.RowItems
     Set ci = Target.Cells.PivotCell.ColumnItems
     Set df = Target.Cells.PivotCell.DataField
@@ -55,44 +51,13 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean
         jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """"
         handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
         handler.sc(i - 1, 1) = ri(i).Name
-        'the following looks for filtered items, but this is redundant because a single one has been isolated
-        'For Each pi In pt.PivotFields(piv_fld_index(rd(i).Name, pt)).PivotItems
-        '    If Not pi.Visible Then
-        '        sql = sql & vbCrLf & "AND " & rd(i).Name & " <> '" & pi.Name & "'"
-        '    End If
-        'Next pi
     Next i
     
-    'this block loops through items selected in colums, which will be ignored for now
-    'For i = 1 To ci.Count
-    '    sql = sql & vbCrLf & "AND "
-    '    sql = sql & cd(piv_pos(cd, ci(i).Parent.Position)).Name & " = '" & ci(i).Name & "'"
-    'Next i
-    
-    'this loop iterates through every pivot field (even if not in the PT) and determines filtered items
-    'For Each pf In Target.Cells.PivotTable.PivotFields
-    '    For Each pi In pf.PivotItems
-    '        If Not pi.Visible Then
-    '            sql = sql & vbCrLf & "AND " & pf.Name & " <> '" & pi.Name & "'"
-    '        End If
-    '    Next pi
-    'Next pf
-    
     
     scenario = "{" & handler.jsql & "}"
-    'Sheets("test").Cells(1, 14) = handler.jsql
     
     Call handler.load_fpvt
     
-    'Call http.pull_months(scenario)
-    
-    'jsql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE j @> '{" & jsql & "}'::jsonb"
-    'sql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE " & sql
-    
-    'MsgBox (sql)
-    
-    'Call wapi.ClipBoard_SetData(sql)
-    
 nopiv:
 
 End Sub
@@ -126,3 +91,5 @@ End Function
 
 
 
+
+