pt/forecast_api
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Too many changes, too few commits.

Browse Source 
A lot has changed here, including:
1. Adding pounds to the data available for display in pivot table.
2. Visual improvements
3. Code simplification
4. Hiding / showing sheets as needed. A developer's backdoor allows for
   easy toggling for debugging purposes: Ctrl+RightClick on the Forecast
   Adjustment form's "Selected Scenario" label.
5. Fixed a bug that happened when deleting rows from the basket. The
   definition of the Target variable was lost in some cases.
6. Made use of the Cancel and Default form properties to purge some
   unnecessary code.
7. Added a sheet that contains Help text for the users.
8. Replacing more harcoded range reference with range names.
9. Refactor checks for division by zero errors, and improve error
   messages for users.
10. Remove manual formatting. It's already done and saved in the
    workbook; there's no need to redo it in code.
11. Added more data validation before Save operation proceeds.
12. Added a new IntersectsWith function to simplify If statements.
This commit is contained in:
PhilRunninger 2023-04-24 21:09:12 -04:00
parent 81174b5d57
commit fde6c97964
16 changed files with 720 additions and 1085 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
VBA/Utils.bas
View File

@ -382,15 +382,15 @@ End Function
Public Function ARRAYp_MakeInteger(ParamArray items()) As Integer() Public Function ARRAYp_MakeInteger(ParamArray items()) As Integer()
Dim x() As Integer Dim X() As Integer
Dim i As Integer Dim i As Integer
ReDim x(UBound(items)) ReDim X(UBound(items))
For i = 0 To UBound(items()) For i = 0 To UBound(items())
x(i) = items(i) X(i) = items(i)
Next i Next i
ARRAYp_MakeInteger = x ARRAYp_MakeInteger = X
End Function End Function
@ -604,15 +604,17 @@ Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox,
'lbHEAD.ZOrder (0) 'lbHEAD.ZOrder (0)
hdr.SpecialEffect = fmSpecialEffectFlat hdr.SpecialEffect = fmSpecialEffectFlat
'hdr.BackColor = RGB(200, 200, 200) 'hdr.BackColor = RGB(200, 200, 200)
hdr.Height = 10 'hdr.Height = 15
' align header to body (should be done last!) ' align header to body (should be done last!)
hdr.width = det.width hdr.width = det.width
hdr.Left = det.Left hdr.Left = det.Left
hdr.Top = det.Top - (hdr.Height - 1) hdr.Top = det.Top - (hdr.Height + 3)
End Sub End Sub
Public Function IntersectsWith(Range1 As Range, Range2 As Range) As Boolean
IntersectsWith = Not Application.Intersect(Range1, Range2) Is Nothing
End Function

70
VBA/build.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build
Caption = "UserForm1" Caption = "Change the Mix"
ClientHeight = 3015 ClientHeight = 1590
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 8100 ClientWidth = 10725
OleObjectBlob = "build.frx":0000 OleObjectBlob = "build.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -13,61 +13,27 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Public part As String
Public bill As String
Public ship As String
Public useval As Boolean
Option Explicit Option Explicit
Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Public useval As Boolean
Select Case KeyCode
Case 13 Private Sub cmdCancel_Click()
useval = True useval = False
Me.Hide Me.Hide
Case 27
useval = False
Me.Hide
End Select
End Sub End Sub
Private Sub cmdOK_Click()
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) useval = True
Me.Hide
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
End Sub End Sub
Public Sub Initialize(part As String, billTo As String, shipTo As String)
Private Sub cbShip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
Select Case KeyCode cbPart.value = part
Case 13 cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
useval = True cbBill.value = billTo
Me.Hide cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
Case 27 cbShip.value = shipTo
useval = False
Me.Hide
End Select
End Sub
Private Sub UserForm_Activate()
useval = False useval = False
cbPart.value = part
cbBill.value = bill
cbShip.value = ship
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
End Sub End Sub

BIN
VBA/build.frx
View File

Binary file not shown.

75
VBA/changes.frm
View File

@ -1,7 +1,7 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
Caption = "History" Caption = "History"
ClientHeight = 7785 ClientHeight = 7815
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 16710 ClientWidth = 16710
@ -13,93 +13,54 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Private x As Variant Private X As Variant
Private Sub cbCancel_Click() Private Sub cbCancel_Click()
Me.Hide Me.Hide
End Sub End Sub
Private Sub cbUndo_Click() Private Sub cbUndo_Click()
Call Me.delete_selected Call Me.delete_selected
End Sub End Sub
Private Sub lbHist_Change() Private Sub lbHist_Change()
Dim i As Integer Dim i As Integer
For i = 0 To Me.lbHist.ListCount - 1 For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then If Me.lbHist.Selected(i) Then
Me.tbPrint.value = x(i, 7) Me.tbPrint.value = X(i, 7)
Exit Sub Exit Sub
End If End If
Next i Next i
End Sub End Sub
Private Sub lbHist_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 46
Call Me.delete_selected
Case 27
Call Me.Hide
End Select
End Sub
Private Sub UserForm_Activate() Private Sub UserForm_Activate()
Dim fail As Boolean Dim fail As Boolean
'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail) X = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & shData.Cells(2, 5) & """}}", fail)
x = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & shData.Cells(2, 5) & """}}", fail)
If fail Then If fail Then
Me.Hide Me.Hide
Exit Sub Exit Sub
End If End If
Me.lbHist.list = x Me.lbHist.list = X
lbHEAD.ColumnCount = lbHist.ColumnCount 'lbHEAD.ColumnCount = lbHist.ColumnCount
lbHEAD.ColumnWidths = lbHist.ColumnWidths 'lbHEAD.ColumnWidths = lbHist.ColumnWidths
' add header elements ' add header elements
lbHEAD.clear ' lbHEAD.clear
lbHEAD.AddItem ' lbHEAD.AddItem
lbHEAD.list(0, 0) = "Modifier" ' lbHEAD.list(0, 0) = "Modifier"
lbHEAD.list(0, 1) = "Owner" ' lbHEAD.list(0, 1) = "Owner"
lbHEAD.list(0, 2) = "When" ' lbHEAD.list(0, 2) = "When"
lbHEAD.list(0, 3) = "Tag" ' lbHEAD.list(0, 3) = "Tag"
lbHEAD.list(0, 4) = "Comment" ' lbHEAD.list(0, 4) = "Comment"
lbHEAD.list(0, 5) = "Sales" ' lbHEAD.list(0, 5) = "Sales"
lbHEAD.list(0, 6) = "id" ' lbHEAD.list(0, 6) = "id"
Call Utils.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id") Call Utils.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id")
' make it pretty
'body.ZOrder (1)
'lbHEAD.ZOrder (0)
'lbHEAD.SpecialEffect = fmSpecialEffectFlat
'lbHEAD.BackColor = RGB(200, 200, 200)
'lbHEAD.Height = 10
' align header to body (should be done last!)
'lbHEAD.width = lbHist.width
'lbHEAD.Left = lbHist.Left
'lbHEAD.Top = lbHist.Top - (lbHEAD.Height - 1)
End Sub End Sub
Sub delete_selected() Sub delete_selected()
Dim logid As Integer Dim logid As Integer
Dim i As Integer Dim i As Integer
Dim fail As Boolean Dim fail As Boolean
@ -109,10 +70,9 @@ Sub delete_selected()
Exit Sub Exit Sub
End If End If
For i = 0 To Me.lbHist.ListCount - 1 For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then If Me.lbHist.Selected(i) Then
Call handler.undo_changes(x(i, 6), fail) Call handler.undo_changes(X(i, 6), fail)
If fail Then If fail Then
MsgBox ("undo did not work") MsgBox ("undo did not work")
Exit Sub Exit Sub
@ -124,5 +84,4 @@ Sub delete_selected()
Me.lbHist.clear Me.lbHist.clear
Me.Hide Me.Hide
End Sub End Sub

BIN
VBA/changes.frx
View File

Binary file not shown.

257
VBA/fpvt.frm
View File

@ -1,7 +1,7 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
Caption = "Forecast Adjustment" Caption = "Forecast Adjustment"
ClientHeight = 8595.001 ClientHeight = 8490.001
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 8670.001 ClientWidth = 8670.001
@ -31,7 +31,6 @@ Private set_swapalt As Boolean
Private return_swap As Boolean Private return_swap As Boolean
Private jswap As Object Private jswap As Object
Private cswap As Object Private cswap As Object
Private cust_s() As Boolean
Private bVol As Double Private bVol As Double
Private bVal As Double Private bVal As Double
@ -61,18 +60,19 @@ Private fPrcm As Double
Option Explicit Option Explicit
Private Sub cbCancel_Click() '=====================================================================================================
' Developers' backdoor to enter or exit debug mode: Ctrl-RightClick on the "Selected Scenario"
tbAdjVol.value = 0 ' label at the top of the form. Debug Mode shows the Pending Changes tab in the form, as well
tbAdjVal.value = 0 ' as all hidden sheets.
tbAdjPrice.value = 0 Private Sub Label62_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
fpvt.Hide If Button = 2 And Shift = 2 Then
shConfig.Range("debug_mode") = Not shConfig.Range("debug_mode")
mp.Pages("pAPIDOC").Visible = shConfig.Range("debug_mode")
End If
End Sub End Sub
'=====================================================================================================
Private Sub butAdjust_Click() Private Sub butAdjust_Click()
Dim fail As Boolean Dim fail As Boolean
Dim doc As String Dim doc As String
@ -81,7 +81,7 @@ Private Sub butAdjust_Click()
Exit Sub Exit Sub
End If End If
If cbTag.text = "" Then If cbTAG.text = "" Then
MsgBox ("no tag was selected") MsgBox ("no tag was selected")
Exit Sub Exit Sub
End If End If
@ -112,22 +112,18 @@ Private Sub butAdjust_Click()
End If End If
Me.tbCOM = "" Me.tbCOM = ""
Me.cbTag.text = "" Me.cbTAG.text = ""
Me.Hide Me.Hide
Set adjust = Nothing Set adjust = Nothing
End Sub End Sub
Private Sub butCancel_Click() Private Sub butCancel_Click()
Me.Hide Me.Hide
End Sub End Sub
Private Sub butMAdjust_Click() Private Sub butMAdjust_Click()
Dim i As Integer Dim i As Integer
Dim fail As Boolean Dim fail As Boolean
@ -138,43 +134,31 @@ Private Sub butMAdjust_Click()
Next i Next i
Me.Hide Me.Hide
End Sub End Sub
Private Sub butMCancel_Click() Private Sub butMCancel_Click()
Me.Hide Me.Hide
End Sub End Sub
Private Sub cbGoSheet_Click() Private Sub cbGoSheet_Click()
shMonthView.Range("MonthComment").value = "" shMonthView.Range("MonthComment").value = ""
shMonthView.Cells(19, 5).value = 0 shMonthView.Range("MonthTag").value = ""
shMonthView.Cells(19, 11).value = 0 shMonthView.Range("QtyPctChange").value = 0
shMonthView.Range("PricePctChange").value = 0
Me.Hide
shMonthView.Range("MonthTags").value = ""
shMonthView.Visible = xlSheetVisible shMonthView.Visible = xlSheetVisible
shMonthView.Select shMonthView.Select
Me.Hide
End Sub End Sub
Private Sub cbTAG_Change() Private Sub cbTAG_Change()
Dim j As Object Dim j As Object
If tbAPI.text = "" Then tbAPI.text = "{}" If tbAPI.text = "" Then tbAPI.text = "{}"
Set j = JsonConverter.ParseJson(tbAPI.text) Set j = JsonConverter.ParseJson(tbAPI.text)
j("tag") = cbTag.value j("tag") = cbTAG.value
tbAPI.text = JsonConverter.ConvertToJson(j) tbAPI.text = JsonConverter.ConvertToJson(j)
End Sub End Sub
Private Sub lbMonth_Change() Private Sub lbMonth_Change()
If clear_lb Or load_tb Then Exit Sub If clear_lb Or load_tb Then Exit Sub
Dim i As Long Dim i As Long
@ -203,13 +187,9 @@ Private Sub lbMonth_Change()
Exit For Exit For
End If End If
Next i Next i
End Sub End Sub
Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub If KeyCode <> 13 Then Exit Sub
Dim i As Long Dim i As Long
If set_swapalt Then Exit Sub If set_swapalt Then Exit Sub
@ -242,15 +222,13 @@ Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift
jswap("user") = Application.UserName jswap("user") = Application.UserName
jswap("source") = "adj" jswap("source") = "adj"
jswap("message") = tbCOM.text jswap("message") = tbCOM.text
jswap("tag") = cbTag.text jswap("tag") = cbTAG.text
jswap("type") = "swap" jswap("type") = "swap"
tbAPI.text = JsonConverter.ConvertToJson(jswap) tbAPI.text = JsonConverter.ConvertToJson(jswap)
End Sub End Sub
Private Sub dbGETSWAP_Click() Private Sub dbGETSWAP_Click()
Dim doc As String Dim doc As String
Dim j As Object Dim j As Object
Dim fail As Boolean Dim fail As Boolean
@ -282,17 +260,13 @@ Private Sub dbGETSWAP_Click()
jswap("user") = Application.UserName jswap("user") = Application.UserName
jswap("source") = "adj" jswap("source") = "adj"
jswap("message") = tbCOM.text jswap("message") = tbCOM.text
jswap("tag") = cbTag.text jswap("tag") = cbTAG.text
jswap("type") = "swap" jswap("type") = "swap"
tbAPI.text = JsonConverter.ConvertToJson(jswap) tbAPI.text = JsonConverter.ConvertToJson(jswap)
End Sub End Sub
Private Sub lbSWAP_Change() Private Sub lbSWAP_Change()
Dim i As Long Dim i As Long
If return_swap Then Exit Sub If return_swap Then Exit Sub
@ -304,40 +278,9 @@ Private Sub lbSWAP_Change()
swapline = i swapline = i
End If End If
Next i Next i
End Sub End Sub
Private Sub lbSWAP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Dim rx As Object
' Set rx = CreateObject("vbscript.regexp")
' rx.Global = True
' rx.Pattern = " - .*"
' Dim match As Object
' Dim i As Long
' Dim v As Variant
'
' 'v = Me.lbSWAP.list
'
' For i = 0 To Me.lbSWAP.ListCount - 1
' If Me.lbSWAP.Selected(i) Then
' part.Show
' If Not part.useval Then
' Exit Sub
' End If
' 'vSwap(i, 3) = rx.Execute(part.cbPart.value)
' 'v(i, 2) = rx.Replace(part.cbPart.value, "")
' 'Me.lbSWAP.list = v
' End If
' Next i
'
End Sub
Private Sub opEditPrice_Click() Private Sub opEditPrice_Click()
opPlugVol.Enabled = False
opPlugPrice.Enabled = False
opPlugVol.Visible = False opPlugVol.Visible = False
opPlugPrice.Visible = False opPlugPrice.Visible = False
opPlugPrice.value = True opPlugPrice.value = True
@ -356,13 +299,9 @@ Private Sub opEditPrice_Click()
tbpv.Enabled = True tbpv.Enabled = True
tbpp.Enabled = True tbpp.Enabled = True
tbpd.Enabled = False tbpd.Enabled = False
End Sub End Sub
Private Sub opEditSales_Click() Private Sub opEditSales_Click()
opPlugVol.Enabled = True
opPlugPrice.Enabled = True
opPlugVol.Visible = True opPlugVol.Visible = True
opPlugPrice.Visible = True opPlugPrice.Visible = True
@ -379,12 +318,9 @@ Private Sub opEditSales_Click()
tbpv.Enabled = False tbpv.Enabled = False
tbpp.Enabled = False tbpp.Enabled = False
tbpd.Enabled = True tbpd.Enabled = True
End Sub End Sub
Private Sub opEditPriceM_Click() Private Sub opEditPriceM_Click()
opmvol.Enabled = False opmvol.Enabled = False
opmprice.Enabled = False opmprice.Enabled = False
opmvol.Visible = False opmvol.Visible = False
@ -398,11 +334,9 @@ Private Sub opEditPriceM_Click()
tbMFVal.BackColor = &H80000005 tbMFVal.BackColor = &H80000005
tbMFVol.Enabled = True tbMFVol.Enabled = True
tbMFVol.BackColor = &H80000018 tbMFVol.BackColor = &H80000018
End Sub End Sub
Private Sub opEditSalesM_Click() Private Sub opEditSalesM_Click()
opmvol.Enabled = True opmvol.Enabled = True
opmprice.Enabled = True opmprice.Enabled = True
opmvol.Visible = True opmvol.Visible = True
@ -414,82 +348,33 @@ Private Sub opEditSalesM_Click()
tbMFVal.BackColor = &H80000018 tbMFVal.BackColor = &H80000018
tbMFVol.Enabled = False tbMFVol.Enabled = False
tbMFVol.BackColor = &H80000005 tbMFVol.BackColor = &H80000005
End Sub
Private Sub opEditVolM_Click()
opmvol.Enabled = False
opmprice.Enabled = False
opmprice.value = False
opmvol.value = True
opmvol.Enabled = False
opmprice.Enabled = False
opmvol.Visible = False
opmprice.Visible = False
tbMFPrice.Enabled = False
tbMFPrice.BackColor = &H80000005
tbMFVal.Enabled = False
tbMFVal.BackColor = &H80000005
tbMFVol.Enabled = True
tbMFVol.BackColor = &H80000018
End Sub End Sub
Private Sub opPlugPrice_Click() Private Sub opPlugPrice_Click()
calc_val calc_val
If opPlugPrice.value = True Then
opPlugPrice.BackColor = -2147483624
Else
opPlugPrice.BackColor = -2147483644
End If
If opPlugVol.value = True Then
opPlugVol.BackColor = -2147483624
Else
opPlugVol.BackColor = -2147483644
End If
End Sub End Sub
Private Sub opPlugVol_Click() Private Sub opPlugVol_Click()
calc_val calc_val
If opPlugVol.value = True Then
opPlugVol.BackColor = -2147483624
Else
opPlugVol.BackColor = -2147483644
End If
If opPlugPrice.value = True Then
opPlugPrice.BackColor = -2147483624
Else
opPlugPrice.BackColor = -2147483644
End If
End Sub End Sub
Private Sub sbpd_Change() Private Sub sbpd_Change()
tbpd.value = sbpd.value tbpd.value = sbpd.value
End Sub End Sub
Private Sub sbpp_Change() Private Sub sbpp_Change()
tbpp.value = sbpp.value tbpp.value = sbpp.value
End Sub End Sub
Private Sub sbpv_Change() Private Sub sbpv_Change()
tbpv.value = sbpv.value tbpv.value = sbpv.value
End Sub End Sub
Private Sub tbCOM_Change() Private Sub tbCOM_Change()
If tbAPI.text = "" Then tbAPI.text = "{}" If tbAPI.text = "" Then tbAPI.text = "{}"
Set adjust = JsonConverter.ParseJson(tbAPI.text) Set adjust = JsonConverter.ParseJson(tbAPI.text)
adjust("message") = tbCOM.text adjust("message") = tbCOM.text
tbAPI.text = JsonConverter.ConvertToJson(adjust) tbAPI.text = JsonConverter.ConvertToJson(adjust)
End Sub End Sub
Private Sub tbFcPrice_Change() Private Sub tbFcPrice_Change()
@ -500,10 +385,8 @@ Private Sub tbFcPrice_Change()
End Sub End Sub
Private Sub tbFcVal_Change() Private Sub tbFcVal_Change()
If load_tb Then Exit Sub If load_tb Then Exit Sub
If opEditSales Then calc_val If opEditSales Then calc_val
End Sub End Sub
Private Sub tbFcVol_Change() Private Sub tbFcVol_Change()
@ -522,72 +405,55 @@ Private Sub opmVol_Click()
End Sub End Sub
Private Sub tbmfPrice_Change() Private Sub tbmfPrice_Change()
If mline = 0 Then Exit Sub If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub If clear_lb Or load_tb Then Exit Sub
set_Price = True set_Price = True
If opEditPriceM Then calc_mprice If opEditPriceM Then calc_mprice
set_Price = False set_Price = False
End Sub End Sub
Private Sub tbMFVal_Change() Private Sub tbMFVal_Change()
If mline = 0 Then Exit Sub If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub If clear_lb Or load_tb Then Exit Sub
If opEditSalesM Then calc_mval If opEditSalesM Then calc_mval
End Sub End Sub
Private Sub tbmfVol_Change() Private Sub tbmfVol_Change()
If mline = 0 Then Exit Sub If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub If clear_lb Or load_tb Then Exit Sub
If opEditPriceM Then calc_mprice If opEditPriceM Then calc_mprice
End Sub End Sub
Private Sub tbpd_Change() Private Sub tbpd_Change()
If load_tb Then Exit Sub If load_tb Then Exit Sub
If Not VBA.IsNumeric(tbpd.value) Then If Not VBA.IsNumeric(tbpd.value) Then
tbpd = "0" tbpd = "0"
End If End If
tbFcVal = (bVal + pVal) * (1 + tbpd.value / 100) tbFcVal = (bVal + pVal) * (1 + tbpd.value / 100)
End Sub End Sub
Private Sub tbpp_Change() Private Sub tbpp_Change()
If load_tb Then Exit Sub If load_tb Then Exit Sub
If Not VBA.IsNumeric(tbpd.value) Then If Not VBA.IsNumeric(tbpd.value) Then
tbpd = "0" tbpd = "0"
End If End If
tbFcPrice = (bPrc + pPrc) * (1 + tbpp.value / 100) tbFcPrice = (bPrc + pPrc) * (1 + tbpp.value / 100)
Me.load_mbox_ann Me.load_mbox_ann
End Sub End Sub
Private Sub tbpv_Change() Private Sub tbpv_Change()
If load_tb Then Exit Sub If load_tb Then Exit Sub
If Not VBA.IsNumeric(tbpv.value) Then If Not VBA.IsNumeric(tbpv.value) Then
tbpd = "0" tbpd = "0"
End If End If
tbFcVol = (bVol + pVol) * (1 + tbpv.value / 100) tbFcVol = (bVol + pVol) * (1 + tbpv.value / 100)
End Sub End Sub
Private Sub UserForm_Activate() Private Sub UserForm_Activate()
Dim i As Long Dim i As Long
Dim j As Long Dim j As Long
Dim k As Long Dim k As Long
Dim ok As Boolean Dim ok As Boolean
' Dim tags() As Variant
Me.Caption = "Forecast Adjust " & shConfig.Range("version").value & " Loading..." Me.Caption = "Forecast Adjust " & shConfig.Range("version").value & " Loading..."
Me.mp.Visible = False Me.mp.Visible = False
@ -604,7 +470,6 @@ Private Sub UserForm_Activate()
Exit Sub Exit Sub
End If End If
'---show existing adjustment if there is one---- '---show existing adjustment if there is one----
fpvt.mod_adjust = False fpvt.mod_adjust = False
pVol = 0 pVol = 0
@ -719,7 +584,6 @@ Private Sub UserForm_Activate()
basket(0, 2) = "ship_cust_descr" basket(0, 2) = "ship_cust_descr"
basket(0, 3) = "mix" basket(0, 3) = "mix"
For i = 1 To UBound(basket, 1) For i = 1 To UBound(basket, 1)
'basket(i, 0) = sp("package")("base")(i)("order_season") 'basket(i, 0) = sp("package")("base")(i)("order_season")
'basket(i, 1) = sp("package")("base")(i)("order_month") 'basket(i, 1) = sp("package")("base")(i)("order_month")
@ -740,7 +604,6 @@ Private Sub UserForm_Activate()
ReDim cust(sp("package")("customers").Count - 1, 3) ReDim cust(sp("package")("customers").Count - 1, 3)
For i = 0 To UBound(cust, 1) For i = 0 To UBound(cust, 1)
cust(i, 0) = sp("package")("customers")(i + 1)("bill_cust_descr") cust(i, 0) = sp("package")("customers")(i + 1)("bill_cust_descr")
cust(i, 1) = "" cust(i, 1) = ""
@ -750,9 +613,8 @@ Private Sub UserForm_Activate()
Call Utils.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace") Call Utils.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
'-------------load tags------------------------------- '-------------load tags-------------------------------
cbTag.list = shConfig.ListObjects("TAGS").DataBodyRange.value cbTAG.list = shConfig.ListObjects("TAGS").DataBodyRange.value
'----------reset spinner buttons---------------------- '----------reset spinner buttons----------------------
sbpv.value = 0 sbpv.value = 0
@ -769,25 +631,11 @@ Private Sub UserForm_Activate()
lbCUST.list = cust lbCUST.list = cust
Call Utils.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit") Call Utils.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
'---------price volume radio button colors----------
If opPlugPrice.value = True Then
opPlugPrice.BackColor = -2147483624
Else
opPlugPrice.BackColor = -2147483644
End If
If opPlugVol.value = True Then
opPlugVol.BackColor = -2147483624
Else
opPlugVol.BackColor = -2147483644
End If
'Application.Calculation = xlCalculationManual
Call handler.month_tosheet(month, basket) Call handler.month_tosheet(month, basket)
Application.StatusBar = False Application.StatusBar = False
Me.mp.Visible = True Me.mp.Visible = True
Me.fraExit.Visible = True Me.fraExit.Visible = True
End Sub End Sub
Sub crunch_array() Sub crunch_array()
@ -828,56 +676,46 @@ Sub crunch_array()
lbMonth.clear lbMonth.clear
lbMonth.list = mload lbMonth.list = mload
clear_lb = False clear_lb = False
End Sub End Sub
Private Sub lbCUST_Change() Private Sub lbCUST_Change()
Dim i As Long Dim i As Long
Dim x() As Variant Dim X() As Variant
x = lbCUST.list X = lbCUST.list
For i = 0 To UBound(x, 1) For i = 0 To UBound(X, 1)
If lbCUST.Selected(i) Then Exit For If lbCUST.Selected(i) Then Exit For
Next i Next i
cbBT.text = x(i, 0) cbBT.text = X(i, 0)
cbST.text = x(i, 2) cbST.text = X(i, 2)
End Sub End Sub
Private Sub cbBT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Private Sub cbBT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub If KeyCode <> 13 Then Exit Sub
Dim i As Long Dim i As Long
Dim x() As Variant Dim X() As Variant
x = lbCUST.list X = lbCUST.list
For i = 0 To UBound(x, 1) For i = 0 To UBound(X, 1)
If lbCUST.Selected(i) Then x(i, 1) = Me.rev_cust(cbBT.text) If lbCUST.Selected(i) Then X(i, 1) = Me.rev_cust(cbBT.text)
Next i Next i
lbCUST.list = x lbCUST.list = X
Call Me.build_cust_swap Call Me.build_cust_swap
End Sub End Sub
Private Sub cbST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Private Sub cbST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub If KeyCode <> 13 Then Exit Sub
Dim i As Long Dim i As Long
Dim x() As Variant Dim X() As Variant
x = lbCUST.list X = lbCUST.list
For i = 0 To UBound(x, 1) For i = 0 To UBound(X, 1)
If lbCUST.Selected(i) Then x(i, 3) = Me.rev_cust(cbST.text) If lbCUST.Selected(i) Then X(i, 3) = Me.rev_cust(cbST.text)
Next i Next i
lbCUST.list = x lbCUST.list = X
Call Me.build_cust_swap Call Me.build_cust_swap
End Sub End Sub
Sub build_cust_swap() Sub build_cust_swap()
@ -896,17 +734,14 @@ Sub build_cust_swap()
cswap("user") = Application.UserName cswap("user") = Application.UserName
cswap("source") = "adj" cswap("source") = "adj"
cswap("message") = tbCOM.text cswap("message") = tbCOM.text
cswap("tag") = cbTag.text cswap("tag") = cbTAG.text
cswap("type") = "cust_swap" cswap("type") = "cust_swap"
Set cswap("swap") = JsonConverter.ParseJson(ptable) Set cswap("swap") = JsonConverter.ParseJson(ptable)
tbAPI.text = JsonConverter.ConvertToJson(cswap) tbAPI.text = JsonConverter.ConvertToJson(cswap)
End Sub End Sub
Public Function rev_cust(cust As String) As String Public Function rev_cust(cust As String) As String
If cust = "" Then If cust = "" Then
rev_cust = "" rev_cust = ""
Exit Function Exit Function
@ -938,7 +773,6 @@ Sub load_var()
aVolm = fVolm - (bVolm + pVolm) aVolm = fVolm - (bVolm + pVolm)
aValm = fValm - (bValm + pValm) aValm = fValm - (bValm + pValm)
If month(mline, 9) = "addmonth" Then If month(mline, 9) = "addmonth" Then
nomonth = True nomonth = True
bPrcm = month(13, 6) / month(13, 2) bPrcm = month(13, 6) / month(13, 2)
@ -951,7 +785,6 @@ Sub load_var()
If fVolm <> 0 Then fPrcm = fValm / fVolm If fVolm <> 0 Then fPrcm = fValm / fVolm
aPrcm = fPrcm - (bPrcm + pPrcm) aPrcm = fPrcm - (bPrcm + pPrcm)
End If End If
End Sub End Sub
Sub load_mbox() Sub load_mbox()
@ -975,7 +808,6 @@ Sub load_mbox()
tbMAPrice = Format(aPrcm, "0.00000") tbMAPrice = Format(aPrcm, "0.00000")
load_tb = False load_tb = False
End Sub End Sub
Sub load_mbox_ann() Sub load_mbox_ann()
@ -999,7 +831,6 @@ Sub load_mbox_ann()
tbAdjPrice = Format(aPrc, "0.00000") tbAdjPrice = Format(aPrc, "0.00000")
load_tb = False load_tb = False
End Sub End Sub
Sub load_array() Sub load_array()
@ -1017,10 +848,8 @@ Sub load_array()
month(mline, 8) = fValm month(mline, 8) = fValm
Me.crunch_array Me.crunch_array
End Sub End Sub
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
If Not IsNumeric(one) Or IsNull(one) Then If Not IsNumeric(one) Or IsNull(one) Then
@ -1082,7 +911,7 @@ Sub calc_val()
adjust("user") = Application.UserName adjust("user") = Application.UserName
adjust("source") = "adj" adjust("source") = "adj"
adjust("message") = tbCOM.text adjust("message") = tbCOM.text
adjust("tag") = cbTag.text adjust("tag") = cbTAG.text
If opEditSales Then If opEditSales Then
If opPlugVol Then If opPlugVol Then
adjust("type") = "scale_v" adjust("type") = "scale_v"
@ -1100,7 +929,6 @@ Sub calc_val()
'print json 'print json
tbAPI = JsonConverter.ConvertToJson(adjust) tbAPI = JsonConverter.ConvertToJson(adjust)
End Sub End Sub
Sub calc_price() Sub calc_price()
@ -1136,7 +964,7 @@ Sub calc_price()
adjust("user") = Application.UserName adjust("user") = Application.UserName
adjust("source") = "adj" adjust("source") = "adj"
adjust("message") = tbCOM.text adjust("message") = tbCOM.text
adjust("tag") = cbTag.text adjust("tag") = cbTAG.text
adjust("version") = handler.plan adjust("version") = handler.plan
If opEditSales Then If opEditSales Then
@ -1159,10 +987,8 @@ Sub calc_price()
'print json 'print json
tbAPI = JsonConverter.ConvertToJson(adjust) tbAPI = JsonConverter.ConvertToJson(adjust)
End Sub End Sub
Sub calc_mval() Sub calc_mval()
Dim pchange As Double Dim pchange As Double
@ -1244,7 +1070,6 @@ Sub calc_mval()
Me.load_mbox Me.load_mbox
Me.load_array Me.load_array
End Sub End Sub
Sub calc_mprice() Sub calc_mprice()
@ -1316,11 +1141,9 @@ Sub calc_mprice()
month(mline, 10) = JsonConverter.ConvertToJson(j) month(mline, 10) = JsonConverter.ConvertToJson(j)
tbAPI = JsonConverter.ConvertToJson(j) tbAPI = JsonConverter.ConvertToJson(j)
If clear_lb Then MsgBox ("clear") If clear_lb Then MsgBox ("clear")
Me.load_mbox Me.load_mbox
Me.load_array Me.load_array
End Sub End Sub
Function iter_def(ByVal iter As String) As String Function iter_def(ByVal iter As String) As String
@ -1344,3 +1167,5 @@ Function iter_def(ByVal iter As String) As String
iter_def = "exclude" iter_def = "exclude"
End Function End Function

BIN
VBA/fpvt.frx
View File

Binary file not shown.

6
VBA/handler.bas
View File

@ -104,7 +104,7 @@ Sub pg_main_workset(rep As String)
Exit Sub Exit Sub
End If End If
ReDim res(json("x").Count, 33) ReDim res(json("x").Count, 34)
For i = 1 To UBound(res, 1) For i = 1 To UBound(res, 1)
res(i, 0) = json("x")(i)("bill_cust_descr") res(i, 0) = json("x")(i)("bill_cust_descr")
@ -141,6 +141,7 @@ Sub pg_main_workset(rep As String)
res(i, 31) = json("x")(i)("logid") res(i, 31) = json("x")(i)("logid")
res(i, 32) = json("x")(i)("tag") res(i, 32) = json("x")(i)("tag")
res(i, 33) = json("x")(i)("comment") res(i, 33) = json("x")(i)("comment")
res(i, 34) = json("x")(i)("pounds")
Next i Next i
res(0, 0) = "bill_cust_descr" res(0, 0) = "bill_cust_descr"
@ -177,6 +178,7 @@ Sub pg_main_workset(rep As String)
res(0, 31) = "logid" res(0, 31) = "logid"
res(0, 32) = "tag" res(0, 32) = "tag"
res(0, 33) = "comment" res(0, 33) = "comment"
res(0, 34) = "pounds"
Set json = Nothing Set json = Nothing
@ -456,7 +458,7 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
shConfig.Range("show_basket").value = 0 shConfig.Range("show_basket").value = 0
shConfig.Range("new_part").value = 0 shConfig.Range("new_part").value = 0
shMonthView.load_sheet shMonthView.LoadSheet
End With End With

7
VBA/openf.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf
Caption = "Open a Forecast" Caption = "Open a Forecast"
ClientHeight = 2025 ClientHeight = 1365
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 3825 ClientWidth = 6825
OleObjectBlob = "openf.frx":0000 OleObjectBlob = "openf.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -33,10 +33,7 @@ End Sub
Private Sub UserForm_Activate() Private Sub UserForm_Activate()
'handler.server = "http://192.168.1.69:3000"
handler.server = shConfig.Range("server").value handler.server = shConfig.Range("server").value
openf.Caption = "Select a DSM"
cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value
End Sub End Sub

BIN
VBA/openf.frx
View File

Binary file not shown.

31
VBA/part.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part
Caption = "Part Picker" Caption = "Part Picker"
ClientHeight = 1080 ClientHeight = 1335
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 8100 ClientWidth = 9285.001
OleObjectBlob = "part.frx":0000 OleObjectBlob = "part.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -13,34 +13,23 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Public part As String
Public bill As String
Public ship As String
Public useval As Boolean
Option Explicit Option Explicit
Public useval As Boolean
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Private Sub cmdCancel_Click()
useval = False
Select Case KeyCode Me.Hide
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
End Sub End Sub
Private Sub cmdOK_Click()
useval = True
Me.Hide
End Sub
Private Sub UserForm_Activate() Private Sub UserForm_Activate()
useval = False useval = False
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
End Sub End Sub

BIN
VBA/part.frx
View File

Binary file not shown.

20
VBA/shConfig.cls
View File

@ -7,3 +7,23 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True Attribute VB_Exposed = True
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If shConfig.Range("debug_mode").value Then
shConfig.Visible = xlSheetVisible
shData.Visible = xlSheetVisible
shMonthView.Visible = xlSheetVisible
shMonthUpdate.Visible = xlSheetVisible
shSupportingData.Visible = xlSheetVisible
shWalk.Visible = xlSheetVisible
Else
shConfig.Visible = xlSheetVeryHidden
shData.Visible = xlSheetHidden
shMonthView.Visible = xlSheetHidden
shMonthUpdate.Visible = xlSheetVeryHidden
shSupportingData.Visible = xlSheetVeryHidden
shWalk.Visible = xlSheetVeryHidden
End If
End Sub

11
VBA/shHelp.cls Normal file
View File

@ -0,0 +1,11 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shHelp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

755
VBA/shMonthView.cls
View File

File diff suppressed because it is too large Load Diff

1
route_sql/get_pool.sql
View File

@ -36,6 +36,7 @@ SELECT
,sum(cost_loc) cost_loc ,sum(cost_loc) cost_loc
,sum(cost_usd) cost_usd ,sum(cost_usd) cost_usd
,sum(units) units ,sum(units) units
,sum(pounds) pounds
,version ,version
,iter ,iter
,logid ,logid