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.

465
VBA/fpvt.frm
View File

File diff suppressed because it is too large Load Diff

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

921
VBA/shMonthView.cls
View File

File diff suppressed because it is too large Load Diff

183
route_sql/get_pool.sql
View File

@ -1,91 +1,92 @@
WITH rows AS ( WITH rows AS (
SELECT SELECT
---------customer info----------------- ---------customer info-----------------
bill_cust_descr bill_cust_descr
,billto_group ,billto_group
,ship_cust_descr ,ship_cust_descr
,shipto_group ,shipto_group
,quota_rep_descr ,quota_rep_descr
,director ,director
,segm ,segm
,substance ,substance
,chan ,chan
,chansub ,chansub
---------product info------------------ ---------product info------------------
,majg_descr ,majg_descr
,ming_descr ,ming_descr
,majs_descr ,majs_descr
,mins_descr ,mins_descr
--,brand --,brand
--,part_family --,part_family
,part_group ,part_group
,branding ,branding
--,color --,color
,part_descr ,part_descr
---------dates------------------------- ---------dates-------------------------
,order_season ,order_season
,order_month ,order_month
,ship_season ,ship_season
,ship_month ,ship_month
,request_season ,request_season
,request_month ,request_month
,promo ,promo
--------values------------------------- --------values-------------------------
,sum(value_loc) value_loc ,sum(value_loc) value_loc
,sum(value_usd) value_usd ,sum(value_usd) value_usd
,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
,version ,sum(pounds) pounds
,iter ,version
,logid ,iter
,tag ,logid
,comment ,tag
FROM ,comment
rlarp.osm_pool FROM
WHERE rlarp.osm_pool
quota_rep_descr = 'rep_replace' WHERE
GROUP BY quota_rep_descr = 'rep_replace'
---------customer info----------------- GROUP BY
bill_cust_descr ---------customer info-----------------
,billto_group bill_cust_descr
,ship_cust_descr ,billto_group
,shipto_group ,ship_cust_descr
,quota_rep_descr ,shipto_group
,director ,quota_rep_descr
,segm ,director
,substance ,segm
,chan ,substance
,chansub ,chan
---------product info------------------ ,chansub
,majg_descr ---------product info------------------
,ming_descr ,majg_descr
,majs_descr ,ming_descr
,mins_descr ,majs_descr
--,brand ,mins_descr
--,part_family --,brand
,part_group --,part_family
,branding ,part_group
--,color ,branding
,part_descr --,color
---------dates------------------------- ,part_descr
,order_season ---------dates-------------------------
,order_month ,order_season
,ship_season ,order_month
,ship_month ,ship_season
,request_season ,ship_month
,request_month ,request_season
,promo ,request_month
,version ,promo
,iter ,version
,logid ,iter
,tag ,logid
,comment ,tag
,substance ,comment
ORDER BY ,substance
logid ASC ORDER BY
) logid ASC
SELECT )
json_agg(row_to_json(rows)) x SELECT
FROM json_agg(row_to_json(rows)) x
rows FROM
rows