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()
Dim x() As Integer
Dim X() As Integer
Dim i As Integer
ReDim x(UBound(items))
ReDim X(UBound(items))
For i = 0 To UBound(items())
x(i) = items(i)
X(i) = items(i)
Next i
ARRAYp_MakeInteger = x
ARRAYp_MakeInteger = X
End Function
@ -604,15 +604,17 @@ Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox,
'lbHEAD.ZOrder (0)
hdr.SpecialEffect = fmSpecialEffectFlat
'hdr.BackColor = RGB(200, 200, 200)
hdr.Height = 10
'hdr.Height = 15
' align header to body (should be done last!)
hdr.width = det.width
hdr.Left = det.Left
hdr.Top = det.Top - (hdr.Height - 1)
hdr.Top = det.Top - (hdr.Height + 3)
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
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build
Caption = "UserForm1"
ClientHeight = 3015
Caption = "Change the Mix"
ClientHeight = 1590
ClientLeft = 120
ClientTop = 465
ClientWidth = 8100
ClientWidth = 10725
OleObjectBlob = "build.frx":0000
StartUpPosition = 1 'CenterOwner
End
@ -13,61 +13,27 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public part As String
Public bill As String
Public ship As String
Public useval As Boolean
Option Explicit
Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
Public useval As Boolean
Private Sub cmdCancel_Click()
useval = False
Me.Hide
End Sub
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
Private Sub cmdOK_Click()
useval = True
Me.Hide
End Sub
Private Sub cbShip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
End Sub
Private Sub UserForm_Activate()
Public Sub Initialize(part As String, billTo As String, shipTo As String)
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
cbPart.value = part
cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
cbBill.value = billTo
cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
cbShip.value = shipTo
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

BIN
VBA/build.frx
View File

Binary file not shown.

75
VBA/changes.frm
View File

@ -1,7 +1,7 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
Caption = "History"
ClientHeight = 7785
ClientHeight = 7815
ClientLeft = 120
ClientTop = 465
ClientWidth = 16710
@ -13,93 +13,54 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private x As Variant
Private X As Variant
Private Sub cbCancel_Click()
Me.Hide
End Sub
Private Sub cbUndo_Click()
Call Me.delete_selected
End Sub
Private Sub lbHist_Change()
Dim i As Integer
For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then
Me.tbPrint.value = x(i, 7)
Me.tbPrint.value = X(i, 7)
Exit Sub
End If
Next i
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()
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
Me.Hide
Exit Sub
End If
Me.lbHist.list = x
Me.lbHist.list = X
lbHEAD.ColumnCount = lbHist.ColumnCount
lbHEAD.ColumnWidths = lbHist.ColumnWidths
'lbHEAD.ColumnCount = lbHist.ColumnCount
'lbHEAD.ColumnWidths = lbHist.ColumnWidths
' add header elements
lbHEAD.clear
lbHEAD.AddItem
lbHEAD.list(0, 0) = "Modifier"
lbHEAD.list(0, 1) = "Owner"
lbHEAD.list(0, 2) = "When"
lbHEAD.list(0, 3) = "Tag"
lbHEAD.list(0, 4) = "Comment"
lbHEAD.list(0, 5) = "Sales"
lbHEAD.list(0, 6) = "id"
' lbHEAD.clear
' lbHEAD.AddItem
' lbHEAD.list(0, 0) = "Modifier"
' lbHEAD.list(0, 1) = "Owner"
' lbHEAD.list(0, 2) = "When"
' lbHEAD.list(0, 3) = "Tag"
' lbHEAD.list(0, 4) = "Comment"
' lbHEAD.list(0, 5) = "Sales"
' lbHEAD.list(0, 6) = "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
Sub delete_selected()
Dim logid As Integer
Dim i As Integer
Dim fail As Boolean
@ -109,10 +70,9 @@ Sub delete_selected()
Exit Sub
End If
For i = 0 To Me.lbHist.ListCount - 1
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
MsgBox ("undo did not work")
Exit Sub
@ -124,5 +84,4 @@ Sub delete_selected()
Me.lbHist.clear
Me.Hide
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
End If
ReDim res(json("x").Count, 33)
ReDim res(json("x").Count, 34)
For i = 1 To UBound(res, 1)
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, 32) = json("x")(i)("tag")
res(i, 33) = json("x")(i)("comment")
res(i, 34) = json("x")(i)("pounds")
Next i
res(0, 0) = "bill_cust_descr"
@ -177,6 +178,7 @@ Sub pg_main_workset(rep As String)
res(0, 31) = "logid"
res(0, 32) = "tag"
res(0, 33) = "comment"
res(0, 34) = "pounds"
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("new_part").value = 0
shMonthView.load_sheet
shMonthView.LoadSheet
End With

7
VBA/openf.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf
Caption = "Open a Forecast"
ClientHeight = 2025
ClientHeight = 1365
ClientLeft = 120
ClientTop = 465
ClientWidth = 3825
ClientWidth = 6825
OleObjectBlob = "openf.frx":0000
StartUpPosition = 1 'CenterOwner
End
@ -33,10 +33,7 @@ End Sub
Private Sub UserForm_Activate()
'handler.server = "http://192.168.1.69:3000"
handler.server = shConfig.Range("server").value
openf.Caption = "Select a DSM"
cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value
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
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part
Caption = "Part Picker"
ClientHeight = 1080
ClientHeight = 1335
ClientLeft = 120
ClientTop = 465
ClientWidth = 8100
ClientWidth = 9285.001
OleObjectBlob = "part.frx":0000
StartUpPosition = 1 'CenterOwner
End
@ -13,34 +13,23 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public part As String
Public bill As String
Public ship As String
Public useval As Boolean
Option Explicit
Public useval As Boolean
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
Private Sub cmdCancel_Click()
useval = False
Me.Hide
End Sub
Private Sub cmdOK_Click()
useval = True
Me.Hide
End Sub
Private Sub UserForm_Activate()
useval = False
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
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_PredeclaredId = 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 (
SELECT
---------customer info-----------------
bill_cust_descr
,billto_group
,ship_cust_descr
,shipto_group
,quota_rep_descr
,director
,segm
,substance
,chan
,chansub
---------product info------------------
,majg_descr
,ming_descr
,majs_descr
,mins_descr
--,brand
--,part_family
,part_group
,branding
--,color
,part_descr
---------dates-------------------------
,order_season
,order_month
,ship_season
,ship_month
,request_season
,request_month
,promo
--------values-------------------------
,sum(value_loc) value_loc
,sum(value_usd) value_usd
,sum(cost_loc) cost_loc
,sum(cost_usd) cost_usd
,sum(units) units
,version
,iter
,logid
,tag
,comment
FROM
rlarp.osm_pool
WHERE
quota_rep_descr = 'rep_replace'
GROUP BY
---------customer info-----------------
bill_cust_descr
,billto_group
,ship_cust_descr
,shipto_group
,quota_rep_descr
,director
,segm
,substance
,chan
,chansub
---------product info------------------
,majg_descr
,ming_descr
,majs_descr
,mins_descr
--,brand
--,part_family
,part_group
,branding
--,color
,part_descr
---------dates-------------------------
,order_season
,order_month
,ship_season
,ship_month
,request_season
,request_month
,promo
,version
,iter
,logid
,tag
,comment
,substance
ORDER BY
logid ASC
)
SELECT
json_agg(row_to_json(rows)) x
FROM
rows
WITH rows AS (
SELECT
---------customer info-----------------
bill_cust_descr
,billto_group
,ship_cust_descr
,shipto_group
,quota_rep_descr
,director
,segm
,substance
,chan
,chansub
---------product info------------------
,majg_descr
,ming_descr
,majs_descr
,mins_descr
--,brand
--,part_family
,part_group
,branding
--,color
,part_descr
---------dates-------------------------
,order_season
,order_month
,ship_season
,ship_month
,request_season
,request_month
,promo
--------values-------------------------
,sum(value_loc) value_loc
,sum(value_usd) value_usd
,sum(cost_loc) cost_loc
,sum(cost_usd) cost_usd
,sum(units) units
,sum(pounds) pounds
,version
,iter
,logid
,tag
,comment
FROM
rlarp.osm_pool
WHERE
quota_rep_descr = 'rep_replace'
GROUP BY
---------customer info-----------------
bill_cust_descr
,billto_group
,ship_cust_descr
,shipto_group
,quota_rep_descr
,director
,segm
,substance
,chan
,chansub
---------product info------------------
,majg_descr
,ming_descr
,majs_descr
,mins_descr
--,brand
--,part_family
,part_group
,branding
--,color
,part_descr
---------dates-------------------------
,order_season
,order_month
,ship_season
,ship_month
,request_season
,request_month
,promo
,version
,iter
,logid
,tag
,comment
,substance
ORDER BY
logid ASC
)
SELECT
json_agg(row_to_json(rows)) x
FROM
rows