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

Compare commits

base: pt:85829efd1d95da74e3ff1f6e5b72124e70a8f5c9
Branches Tags
pt:dev
pt:master
pt:v1.6.2
pt:v1.6.1
pt:v1.6
pt:v1.5
pt:v1.3
pt:v1.2
pt:v1.0
pt:v0.9
pt:v0.8
pt:v0.6
pt:v0.5
pt:v0.4
pt:v0.3
pt:v0.2
pt:v0.1
..
compare: pt:0ae9f604c1baf1ff477108bc5d9586c6ec81559c
Branches Tags
pt:dev
pt:master
pt:v1.6.2
pt:v1.6.1
pt:v1.6
pt:v1.5
pt:v1.3
pt:v1.2
pt:v1.0
pt:v0.9
pt:v0.8
pt:v0.6
pt:v0.5
pt:v0.4
pt:v0.3
pt:v0.2
pt:v0.1

No commits in common. "85829efd1d95da74e3ff1f6e5b72124e70a8f5c9" and "0ae9f604c1baf1ff477108bc5d9586c6ec81559c" have entirely different histories.
85829efd1d ... 0ae9f604c1

28 changed files with 3395 additions and 423 deletions
Show Stats Expand all files Collapse all files

4
VBA/JsonDebugPrint.bas
View File

@ -3,8 +3,8 @@ Option Explicit
Public Sub TestPrintJSON()
PrintJSON ParseJson("[1,2,3]")
PrintJSON ParseJson("[{""a"":123,""b"":[56,7,78]}]")
PrintJSON ParseJSON("[1,2,3]")
PrintJSON ParseJSON("[{""a"":123,""b"":[56,7,78]}]")
End Sub
' This is definitely NOT a pretty printer. It was written merely as a debugging

2730
VBA/TheBigOne.cls Normal file
View File

File diff suppressed because it is too large Load Diff

9
VBA/ThisWorkbook.cls
View File

@ -1,9 +0,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ThisWorkbook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True

247
VBA/Windows_API.cls Normal file
View File

@ -0,0 +1,247 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Windows_API"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardOwner Lib "user32" () As LongPtr
Private Declare PtrSafe Function SetClipboardViewer Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardViewer Lib "user32" () As LongPtr
Private Declare PtrSafe Function ChangeClipboardChain Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndNext As LongPtr) As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" Alias "GetClipboardDataA" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function CountClipboardFormats Lib "user32" () As Long
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" _
(ByVal wFormat As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetPriorityClipboardFormat Lib "user32" (lpPriorityList As Long, ByVal nCount As Long) As Long
Private Declare PtrSafe Function GetOpenClipboardWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function CharToOem Lib "user32" Alias "CharToOemA" _
(ByVal lpszSrc As String, _
ByVal lpszDst As String) As Long
Private Declare PtrSafe Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare PtrSafe Function CharToOemBuff Lib "user32" Alias "CharToOemBuffA" _
(ByVal lpszSrc As String, _
ByVal lpszDst As String, _
ByVal cchDstLength As Long) As Long
Private Declare PtrSafe Function OemToCharBuff Lib "user32" Alias "OemToCharBuffA" _
(ByVal lpszSrc As String, _
ByVal lpszDst As String, _
ByVal cchDstLength As Long) As Long
Private Declare PtrSafe Function CharUpper Lib "user32" Alias "CharUpperA" (ByVal lpsz As String) As String
Private Declare PtrSafe Function CharUpperBuff Lib "user32" Alias "CharUpperBuffA" (ByVal lpsz As String, ByVal cchLength As Long) As Long
Private Declare PtrSafe Function CharLower Lib "user32" Alias "CharLowerA" (ByVal lpsz As String) As String
Private Declare PtrSafe Function CharLowerBuff Lib "user32" Alias "CharLowerBuffA" (ByVal lpsz As String, ByVal cchLength As Long) As Long
Private Declare PtrSafe Function CharNext Lib "user32" Alias "CharNextA" (ByVal lpsz As String) As String
Private Declare PtrSafe Function CharPrev Lib "user32" Alias "CharPrevA" (ByVal lpszStart As String, ByVal lpszCurrent As String) As String
Private Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalHandle Lib "kernel32" (wMem As Any) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalReAlloc Lib "kernel32" (ByVal hMem As LongPtr, ByVal dwBytes As LongPtr, ByVal wFlags As Long) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Declare PtrSafe Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type MSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE As Long = &H1
Private Const WM_CHAR As Long = &H102
Private Const GHND As Long = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 40096
Private bExitLoop As Boolean
Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As LongPtr
Dim iLen As LongPtr
Dim iLock As LongPtr
Const GMEM_MOVEABLE As Long = &H2
Const GMEM_ZEROINIT As Long = &H40
Const CF_UNICODETEXT As Long = &HD
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub
Public Sub ClipBoard_SetData(sUniText As String)
Dim hGlobalMemory As LongPtr
Dim lpGlobalMemory As LongPtr
Dim hClipMemory As LongPtr
Dim x As Long
hGlobalMemory = GlobalAlloc(GHND, Len(sUniText) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, sUniText)
If GlobalUnlock(hGlobalMemory) <> 0 Then
GoTo OutOfHere2
End If
If OpenClipboard(0&) = 0 Then
Exit Sub
End If
x = EmptyClipboard()
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox ("ruh-roh")
End If
End Sub
Public Function GetClipboard() As String
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Dim sUniText As String
Const CF_UNICODETEXT As Long = 13&
OpenClipboard 0&
If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
iStrPtr = GetClipboardData(CF_UNICODETEXT)
If iStrPtr Then
iLock = GlobalLock(iStrPtr)
iLen = GlobalSize(iStrPtr)
sUniText = String$(iLen \ 2& - 1&, vbNullChar)
lstrcpy StrPtr(sUniText), iLock
GlobalUnlock iStrPtr
End If
GetClipboard = sUniText
End If
CloseClipboard
End Function
Sub TrackKeyPressInit()
Dim msgMessage As MSG
Dim bCancel As Boolean
Dim iKeyCode As Integer
Dim lXLhwnd As Long
On Error GoTo errHandler:
Application.EnableCancelKey = xlErrorHandler
'initialize this boolean flag.
bExitLoop = False
'get the app hwnd.
lXLhwnd = FindWindow("XLMAIN", Application.Caption)
Do
WaitMessage
'check for a key press and remove it from the msg queue.
If PeekMessage _
(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
'strore the virtual key code for later use.
iKeyCode = msgMessage.wParam
'translate the virtual key code into a char msg.
TranslateMessage msgMessage
PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
WM_CHAR, PM_REMOVE
'for some obscure reason, the following
'keys are not trapped inside the event handler
'so we handle them here.
If iKeyCode = vbKeyBack Then SendKeys "{BS}"
If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
'assume the cancel argument is False.
bCancel = False
'the VBA RaiseEvent statement does not seem to return ByRef arguments
'so we call a KeyPress routine rather than a propper event handler.
Sheet_KeyPress ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel
'if the key pressed is allowed post it to the application.
If bCancel = False Then
PostMessage _
lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
End If
End If
errHandler:
'allow the processing of other msgs.
DoEvents
Loop Until bExitLoop
End Sub
Sub StopKeyWatch()
'set this boolean flag to exit the above loop.
bExitLoop = True
End Sub
'\\This example illustrates how to catch worksheet
'\\Key strokes in order to prevent entering numeric
'\\characters in the Range "A1:D10" .
Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As Range, Cancel As Boolean)
Const MSG As String = "Numeric Characters are not allowed in" & vbNewLine & "the Range: """
Const TITLE As String = "Invalid Entry !"
If Not Intersect(Target, Range("A1:D10")) Is Nothing Then
If Chr(KeyAscii) Like "[0-9]" Then
MsgBox MSG & Range("A1:D10").address(False, False) _
& """ .", vbCritical, TITLE
Cancel = True
End If
End If
End Sub

14
VBA/build.frm
View File

@ -19,6 +19,9 @@ 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
@ -64,9 +67,14 @@ Private Sub UserForm_Activate()
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
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A2").CurrentRegion)
'cbPart.list(1).Remove
cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
'cbPart.list(1).Remove
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
'cbPart.list(1).Remove
End Sub

BIN
VBA/build.frx
View File

Binary file not shown.

12
VBA/changes.frm
View File

@ -56,12 +56,17 @@ End Sub
Private Sub tbPrint_Change()
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"":""" & Sheets("data").Cells(2, 5) & """}}", fail)
If fail Then
Me.Hide
Exit Sub
@ -81,7 +86,8 @@ Private Sub UserForm_Activate()
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")
Dim tbo As New TheBigOne
Call tbo.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id")
' make it pretty
@ -120,7 +126,7 @@ Sub delete_selected()
End If
Next i
shOrders.PivotTables("ptOrders").PivotCache.Refresh
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
Me.lbHist.clear
Me.Hide

BIN
VBA/changes.frx
View File

Binary file not shown.

76
VBA/fpvt.frm
View File

@ -129,11 +129,10 @@ End Sub
Private Sub butMAdjust_Click()
Dim i As Integer
Dim fail As Boolean
For i = 1 To 12
If month(i, 10) <> "" Then
Call handler.request_adjust(CStr(month(i, 10)), fail)
Call handler.request_adjust(CStr(month(i, 10)))
End If
Next i
@ -150,14 +149,14 @@ End Sub
Private Sub cbGoSheet_Click()
shMonthView.tbMCOM.text = ""
shMonthView.sbMPV.value = 0
shMonthView.sbMPP.value = 0
Worksheets("month").tbMCOM.text = ""
Worksheets("month").sbMPV.value = 0
Worksheets("month").sbMPP.value = 0
Me.Hide
shMonthView.cbMTAG.value = ""
shMonthView.Visible = xlSheetVisible
shMonthView.Select
months.cbMTAG.value = ""
Worksheets("month").Visible = xlSheetVisible
Sheets("month").Select
End Sub
@ -230,10 +229,10 @@ Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift
End If
Next i
vtable = Utils.ARRAYp_TransposeVar(vSwap)
vtable = Utils.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
vtable = Utils.ARRAYp_TransposeVar(vtable)
ptable = Utils.json_from_table_zb(vtable, "rows", True, False)
vtable = x.ARRAYp_TransposeVar(vSwap)
vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
vtable = x.ARRAYp_TransposeVar(vtable)
ptable = x.json_from_table_zb(vtable, "rows", True, False)
Set jswap("swap") = JsonConverter.ParseJson(ptable)
jswap("scenario")("version") = handler.plan
@ -266,14 +265,14 @@ Private Sub dbGETSWAP_Click()
lbSWAP.list = vSwap
'Call x.frmListBoxHeader(lbSWAPH, lbSWAP, "Original", "Sales", "Replacement", "Fit")
cbPLIST.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
cbPLIST.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
'---------build change-------------
Set jswap = j
vtable = Utils.ARRAYp_TransposeVar(vSwap)
vtable = Utils.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
vtable = Utils.ARRAYp_TransposeVar(vtable)
ptable = Utils.json_from_table_zb(vtable, "rows", True, False)
vtable = x.ARRAYp_TransposeVar(vSwap)
vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
vtable = x.ARRAYp_TransposeVar(vtable)
ptable = x.json_from_table_zb(vtable, "rows", True, False)
Set jswap("swap") = JsonConverter.ParseJson(ptable)
jswap("scenario")("version") = handler.plan
@ -465,6 +464,10 @@ Private Sub opPlugVol_Click()
End If
End Sub
Private Sub pickSWAP_Change()
End Sub
Private Sub sbpd_Change()
tbpd.value = sbpd.value
@ -589,13 +592,13 @@ Private Sub UserForm_Activate()
Dim ok As Boolean
Dim tags() As Variant
Me.Caption = "Forecast Adjust " & shConfig.Cells(8, 2)
Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2)
Me.mp.Visible = False
Me.lheader = "Loading..."
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
Call x.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
Me.lheader = "Ready"
@ -630,7 +633,7 @@ Private Sub UserForm_Activate()
For i = 1 To sp("package")("totals").Count
Select Case sp("package")("totals")(i)("order_season")
Case 2024
Case 2023
Select Case Me.iter_def(sp("package")("totals")(i)("iter"))
Case "baseline"
bVol = bVol + sp("package")("totals")(i)("units")
@ -749,7 +752,7 @@ Private Sub UserForm_Activate()
cust(i, 3) = ""
Next i
Call Utils.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
Call x.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
'-------------load tags-------------------------------
@ -759,9 +762,9 @@ Private Sub UserForm_Activate()
tags(i - 1, 0) = sp("package")("tags")(i)
Next i
cbTAG.list = tags
shMonthView.cbMTAG.list = tags
Sheets("month").cbMTAG.list = tags
cbTAG.ListRows = UBound(tags, 1) + 1
shMonthView.cbMTAG.ListRows = UBound(tags, 1) + 1
months.cbMTAG.ListRows = UBound(tags, 1) + 1
End If
'----------reset spinner buttons----------------------
@ -773,11 +776,11 @@ Private Sub UserForm_Activate()
lbSWAP.clear
pickSWAP.value = ""
pickSWAP.text = Mid(sp("package")("basket")(1)("part_descr"), 1, 8)
pickSWAP.list = shSupportingData.ListObjects("MOLD").DataBodyRange.value
cbBT.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
cbST.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F2").CurrentRegion)
cbBT.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
cbST.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
lbCUST.list = cust
Call Utils.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
'---------price volume radio button colors----------
If opPlugPrice.value = True Then
@ -895,10 +898,10 @@ Sub build_cust_swap()
Dim vtable() As Variant
Dim ptable As String
vtable = lbCUST.list
vtable = Utils.ARRAYp_TransposeVar(vtable)
vtable = Utils.ARRAYp_zerobased_addheader(vtable, "bill", "bill_r", "ship", "ship_r")
vtable = Utils.ARRAYp_TransposeVar(vtable)
ptable = Utils.json_from_table_zb(vtable, "rows", True, False)
vtable = x.ARRAYp_TransposeVar(vtable)
vtable = x.ARRAYp_zerobased_addheader(vtable, "bill", "bill_r", "ship", "ship_r")
vtable = x.ARRAYp_TransposeVar(vtable)
ptable = x.json_from_table_zb(vtable, "rows", True, False)
Set cswap = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}")
cswap("scenario")("version") = handler.plan
cswap("scenario")("iter") = handler.basis
@ -1354,3 +1357,12 @@ Function iter_def(ByVal iter As String) As String
iter_def = "exclude"
End Function
Sub new_part()
End Sub
Private Sub UserForm_Initialize()
End Sub

BIN
VBA/fpvt.frx
View File

Binary file not shown.

246
VBA/handler.bas
View File

@ -5,6 +5,8 @@ Public sql As String
Public jsql As String
Public scenario As String
Public sc() As Variant
Public x As New TheBigOne
Public wapi As New Windows_API
Public data() As String
Public agg() As String
Public showprice As Boolean
@ -19,6 +21,8 @@ Sub load_fpvt()
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))
Dim i As Long
Dim s_tot As Object
@ -74,6 +78,7 @@ End Function
Sub pg_main_workset(rep 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
@ -176,8 +181,8 @@ Sub pg_main_workset(rep As String)
ReDim str(UBound(res, 1), UBound(res, 2))
shData.Cells.ClearContents
Call Utils.SHTp_DumpVar(res, shData.Name, 1, 1, False, True, True)
Worksheets("data").Cells.ClearContents
Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
End Sub
@ -209,7 +214,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
'doc = JsonConverter.ConvertToJson(doc)
server = shConfig.Cells(1, 2)
server = Sheets("config").Cells(1, 2)
With req
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
@ -306,16 +311,16 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
' Next i
i = 1
Do Until shData.Cells(i, 1) = ""
Do Until Sheets("data").Cells(i, 1) = ""
i = i + 1
Loop
Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
'Call Utils.SHTp_Dump(str, shData.Name, CLng(i), 1, False, False, 28, 29, 30, 31, 32)
'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
shOrders.PivotTables("ptOrders").PivotCache.Refresh
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
End Function
@ -324,13 +329,13 @@ Sub load_config()
Dim i As Integer
Dim j As Integer
'----server to use---------------------------------------------------------
handler.server = shConfig.Cells(1, 2)
handler.server = Sheets("config").Cells(1, 2)
'---basis-----------------------------------------------------------------
ReDim handler.basis(100)
i = 2
j = 0
Do While shConfig.Cells(2, i) <> ""
handler.basis(j) = shConfig.Cells(2, i)
Do While Sheets("config").Cells(2, i) <> ""
handler.basis(j) = Sheets("config").Cells(2, i)
j = j + 1
i = i + 1
Loop
@ -339,8 +344,8 @@ Sub load_config()
ReDim handler.baseline(100)
i = 2
j = 0
Do While shConfig.Cells(3, i) <> ""
handler.baseline(j) = shConfig.Cells(3, i)
Do While Sheets("config").Cells(3, i) <> ""
handler.baseline(j) = Sheets("config").Cells(3, i)
j = j + 1
i = i + 1
Loop
@ -349,14 +354,14 @@ Sub load_config()
ReDim handler.adjust(100)
i = 2
j = 0
Do While shConfig.Cells(4, i) <> ""
handler.adjust(j) = shConfig.Cells(4, i)
Do While Sheets("config").Cells(4, i) <> ""
handler.adjust(j) = Sheets("config").Cells(4, i)
j = j + 1
i = i + 1
Loop
ReDim Preserve handler.adjust(j - 1)
'---plan version--------------------------------------------------------------
handler.plan = shConfig.Cells(9, 2)
handler.plan = Sheets("config").Cells(9, 2)
End Sub
@ -365,105 +370,104 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
Dim j As Object
Dim i As Integer
Dim r As Long
Dim sh As Worksheet
Set sh = Sheets("_month")
With shMonthUpdate
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
sh.Cells(1, 16) = JsonConverter.ConvertToJson(j)
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
.Cells(1, 16) = JsonConverter.ConvertToJson(j)
For i = 0 To 12
'------------volume-------------------
sh.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
sh.Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
sh.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
sh.Cells(i + 1, 4) = 0
sh.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
For i = 0 To 12
'------------volume-------------------
.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
.Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
.Cells(i + 1, 4) = 0
.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
'------------value----------------------
.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
.Cells(i + 1, 14) = 0
.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
'-------------price----------------------
If i > 0 Then
'--prior--
If co_num(pkg(i, 1), 0) = 0 Then
.Cells(i + 1, 6) = 0
Else
.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
End If
'--base--
If co_num(pkg(i, 2), 0) = 0 Then
'if there is no monthly base volume,
'then use the prior price, if there was no prior price,
'then inherit the average price for the year before current adjustments
If .Cells(i, 7) <> 0 Then
.Cells(i + 1, 7) = .Cells(i, 7)
Else
If pkg(13, 1) + pkg(13, 2) = 0 Then
.Cells(i + 1, 7) = 0
Else
.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
End If
End If
Else
.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
End If
'--adjust--
If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
.Cells(i + 1, 8) = 0
Else
.Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
End If
'--current adjust--
.Cells(i + 1, 9) = 0
'--forecast--
If co_num(pkg(i, 4), 0) = 0 Then
'if there is no monthly base volume,
'then use the prior price, if there was no prior price,
'then inherit the average price for the year before current adjustments
If .Cells(i, 10) <> 0 Then
.Cells(i + 1, 10) = .Cells(i, 10)
Else
If pkg(13, 1) + pkg(13, 2) = 0 Then
.Cells(i + 1, 10) = 0
Else
.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
End If
End If
Else
.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
End If
'------------value----------------------
sh.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
sh.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
sh.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
sh.Cells(i + 1, 14) = 0
sh.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
'-------------price----------------------
If i > 0 Then
'--prior--
If co_num(pkg(i, 1), 0) = 0 Then
sh.Cells(i + 1, 6) = 0
Else
sh.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
End If
Next i
'--base--
If co_num(pkg(i, 2), 0) = 0 Then
'if there is no monthly base volume,
'then use the prior price, if there was no prior price,
'then inherit the average price for the year before current adjustments
If sh.Cells(i, 7) <> 0 Then
sh.Cells(i + 1, 7) = sh.Cells(i, 7)
Else
If pkg(13, 1) + pkg(13, 2) = 0 Then
sh.Cells(i + 1, 7) = 0
Else
sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
End If
End If
Else
sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
End If
'--adjust--
If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
sh.Cells(i + 1, 8) = 0
Else
sh.Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
End If
'--current adjust--
sh.Cells(i + 1, 9) = 0
'--forecast--
If co_num(pkg(i, 4), 0) = 0 Then
'if there is no monthly base volume,
'then use the prior price, if there was no prior price,
'then inherit the average price for the year before current adjustments
If sh.Cells(i, 10) <> 0 Then
sh.Cells(i + 1, 10) = sh.Cells(i, 10)
Else
If pkg(13, 1) + pkg(13, 2) = 0 Then
sh.Cells(i + 1, 10) = 0
Else
sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
End If
End If
Else
sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
End If
End If
'scenario
.Range("R1:S1000").ClearContents
For i = 0 To UBound(handler.sc, 1)
.Cells(i + 1, 18) = handler.sc(i, 0)
.Cells(i + 1, 19) = handler.sc(i, 1)
Next i
'basket
.Range("U1:AC100000").ClearContents
Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True)
Call Utils.SHTp_DumpVar(basket, .Name, 1, 26, False, False, True)
shConfig.Cells(5, 2) = 0
shConfig.Cells(6, 2) = 0
shConfig.Cells(7, 2) = 0
shMonthView.load_sheet
Next i
'scenario
Sheets("_month").Range("R1:S1000").ClearContents
For i = 0 To UBound(handler.sc, 1)
sh.Cells(i + 1, 18) = handler.sc(i, 0)
sh.Cells(i + 1, 19) = handler.sc(i, 1)
Next i
'basket
sh.Range("U1:AC100000").ClearContents
Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
Sheets("config").Cells(5, 2) = 0
Sheets("config").Cells(6, 2) = 0
Sheets("config").Cells(7, 2) = 0
months.load_sheet
End With
End Sub
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
@ -491,7 +495,7 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
Exit Function
End If
server = shConfig.Cells(1, 2)
server = Sheets("config").Cells(1, 2)
With req
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
@ -555,10 +559,12 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
logid = json("x")(1)("id")
'---------loop through and get a list of each row that needs deleted?-----
Set ds = Sheets("data")
j = 0
For i = 1 To 100
If shData.Cells(1, i) = "logid" Then
If ds.Cells(1, i) = "logid" Then
j = i
Exit For
End If
@ -571,15 +577,15 @@ Function undo_changes(ByVal logid As Integer, ByRef fail As Boolean) As Variant(
End If
i = 2
With shData
While .Cells(i, 1) <> ""
If .Cells(i, j) = logid Then
.Rows(i).Delete
Else
i = i + 1
End If
Wend
End With
While ds.Cells(i, 1) <> ""
If ds.Cells(i, j) = logid Then
ds.Rows(i).Delete
Else
i = i + 1
End If
Wend
End Function
@ -604,7 +610,7 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
Exit Function
End If
server = shConfig.Cells(1, 2)
server = Sheets("config").Cells(1, 2)
With req
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All

241
VBA/shMonthView.cls → VBA/months.cls
View File

@ -2,13 +2,14 @@ VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shMonthView"
Attribute VB_Name = "months"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private x As New TheBigOne
Private units() As Variant
Private price() As Variant
Private sales() As Variant
@ -30,6 +31,13 @@ Private b() As Variant 'holds basket
Private did_load_config As Boolean
Private Sub cbMTAG_Change()
End Sub
Private Sub sbMPP_Change()
Dim m As Worksheet
Dim i As Long
@ -38,7 +46,7 @@ Private Sub sbMPP_Change()
dumping = True
Set m = shMonthView
Set m = Sheets("month")
m.Cells(19, 11) = sbMPP.value / 100
For i = 6 To 17
m.Cells(i, 11) = (m.Cells(i, 9)) * m.Cells(19, 11)
@ -60,7 +68,7 @@ Private Sub sbMPV_Change()
dumping = True
Set m = shMonthView
Set m = Sheets("month")
m.Cells(19, 5) = sbMPV.value / 100
For i = 6 To 17
If m.Cells(i, 5) <> "" Then
@ -109,7 +117,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
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 And shConfig.Cells(6, 2) = 1 Then
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Set basket_touch = Target
Call Me.get_edit_basket
Set basket_touch = Nothing
@ -121,7 +129,7 @@ End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Cancel = True
Call Me.basket_pick(Target)
Target.Select
@ -132,7 +140,7 @@ End Sub
Sub picker_shortcut()
If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Call Me.basket_pick(Selection)
End If
@ -140,7 +148,7 @@ End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Cancel = True
Call Me.basket_pick(Target)
Target.Select
@ -220,7 +228,7 @@ On Error GoTo errh
Dim i As Integer
Call Me.get_sheet
Dim vp As String
vp = shMonthView.Range("Q2")
vp = Sheets("month").Range("Q2")
For i = 1 To 12
If sales(i, 5) = "" Then sales(i, 5) = 0
@ -276,7 +284,7 @@ Sub ms_adj()
Dim i As Integer
Call Me.get_sheet
Dim vp As String
vp = shMonthView.Range("Q2")
vp = Sheets("month").Range("Q2")
For i = 1 To 12
If sales(i, 4) = "" Then sales(i, 4) = 0
@ -336,7 +344,7 @@ Sub get_sheet()
tprice = Range("H18:L18")
tsales = Range("N18:R18")
ReDim adjust(12)
Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
End Sub
@ -353,15 +361,15 @@ Sub set_sheet()
Range("H18:L18").FormulaR1C1 = tprice
Range("N18:R18").FormulaR1C1 = tsales
Range("T6:U18").ClearContents
Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("R1")), shMonthView.Name, 6, 20, False, False, False)
'shMonthView.Range("B32:Q5000").ClearContents
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
'Sheets("month").Range("B32:Q5000").ClearContents
If Me.newpart Then
shMonthUpdate.Range("P2:P13").ClearContents
shMonthUpdate.Cells(2, 16) = JsonConverter.ConvertToJson(np)
Sheets("_month").Range("P2:P13").ClearContents
Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
Else
For i = 1 To 12
shMonthUpdate.Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
Next i
End If
@ -371,16 +379,16 @@ End Sub
Sub load_sheet()
units = shMonthUpdate.Range("A2:E13").FormulaR1C1
price = shMonthUpdate.Range("F2:J13").FormulaR1C1
sales = shMonthUpdate.Range("K2:O13").FormulaR1C1
scenario = shMonthUpdate.Range("R1:S13").FormulaR1C1
units = Sheets("_month").Range("A2:E13").FormulaR1C1
price = Sheets("_month").Range("F2:J13").FormulaR1C1
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
tunits = Range("B18:F18")
tprice = Range("H18:L18")
tsales = Range("N18:R18")
'reset basket
shMonthUpdate.Range("U1:X10000").ClearContents
Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("Z1")), shMonthUpdate.Name, 1, 21, False, False, False)
Sheets("_month").Range("U1:X10000").ClearContents
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
ReDim adjust(12)
Call Me.crunch_array
Call Me.set_sheet
@ -402,17 +410,17 @@ Sub set_format()
Dim val_adj As Range
Dim val_set As Range
Set prices = shMonthView.Range("H6:L17")
Set price_adj = shMonthView.Range("K6:K17")
Set price_set = shMonthView.Range("L6:L17")
Set prices = Sheets("month").Range("H6:L17")
Set price_adj = Sheets("month").Range("K6:K17")
Set price_set = Sheets("month").Range("L6:L17")
Set vol = shMonthView.Range("B6:F17")
Set vol_adj = shMonthView.Range("E6:E17")
Set vol_set = shMonthView.Range("F6:F17")
Set vol = Sheets("month").Range("B6:F17")
Set vol_adj = Sheets("month").Range("E6:E17")
Set vol_set = Sheets("month").Range("F6:F17")
Set val = shMonthView.Range("N6:R17")
Set val_adj = shMonthView.Range("Q6:Q17")
Set val_set = shMonthView.Range("R6:R17")
Set val = Sheets("month").Range("N6:R17")
Set val_adj = Sheets("month").Range("Q6:Q17")
Set val_set = Sheets("month").Range("R6:R17")
Call Me.format_price(prices)
Call Me.set_border(prices)
@ -533,8 +541,8 @@ Sub build_json()
ReDim handler.basis(100)
i = 2
j = 0
Do While shConfig.Cells(2, i) <> ""
handler.basis(j) = shConfig.Cells(2, i)
Do While Sheets("config").Cells(2, i) <> ""
handler.basis(j) = Sheets("config").Cells(2, i)
j = j + 1
i = i + 1
Loop
@ -560,7 +568,7 @@ Sub build_json()
Set o = JsonConverter.ParseJson("{}")
o("amount") = sales(pos, 5)
o("qty") = units(pos, 5)
Set m(shMonthView.Cells(5 + pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
Set m(Worksheets("month").Cells(5 + pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
End If
Else
'if something is changing
@ -577,7 +585,7 @@ Sub build_json()
'--ignore above comment and always use add month_vp
adjust(pos)("type") = "addmonth_vp"
End If
adjust(pos)("month") = shMonthView.Cells(5 + pos, 1)
adjust(pos)("month") = Worksheets("month").Cells(5 + pos, 1)
adjust(pos)("qty") = units(pos, 4)
adjust(pos)("amount") = sales(pos, 4)
Else
@ -595,7 +603,7 @@ Sub build_json()
adjust(pos)("qty") = units(pos, 4)
adjust(pos)("amount") = sales(pos, 4)
'------------add this in to only scale a particular month--------------------
adjust(pos)("scenario")("order_month") = shMonthView.Cells(5 + pos, 1)
adjust(pos)("scenario")("order_month") = Worksheets("month").Cells(5 + pos, 1)
End If
adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
adjust(pos)("user") = Application.UserName
@ -608,24 +616,24 @@ Sub build_json()
If Me.newpart Then
Set np("months") = JsonConverter.ParseJson(JsonConverter.ConvertToJson(m))
np("newpart") = shMonthView.Range("B33").value
np("newpart") = Worksheets("month").Range("B33").value
'np("basket") = x.json_from_table(b, "basket", False)
'get the basket from the sheet
b = shMonthUpdate.Range("U1").CurrentRegion.value
Set m = JsonConverter.ParseJson(Utils.json_from_table(b, "basket", False))
b = Worksheets("_month").Range("U1").CurrentRegion.value
Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
If UBound(b, 1) <= 2 Then
Set np("basket") = JsonConverter.ParseJson("[" & Utils.json_from_table(b, "basket", False) & "]")
Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
Else
Set np("basket") = m("basket")
End If
End If
If Me.newpart Then
shMonthUpdate.Range("P2:P13").ClearContents
shMonthUpdate.Cells(2, 16) = JsonConverter.ConvertToJson(np)
Sheets("_month").Range("P2:P13").ClearContents
Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
Else
For i = 1 To 12
shMonthUpdate.Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
Next i
End If
@ -681,11 +689,12 @@ End Sub
Sub Cancel()
shOrders.Select
Sheets("Orders").Select
End Sub
Sub reset()
Call Me.load_sheet
@ -694,10 +703,10 @@ End Sub
Sub switch_basket()
If shConfig.Cells(6, 2) = 1 Then
shConfig.Cells(6, 2) = 0
If Sheets("config").Cells(6, 2) = 1 Then
Sheets("config").Cells(6, 2) = 0
Else
shConfig.Cells(6, 2) = 1
Sheets("config").Cells(6, 2) = 1
End If
Call Me.print_basket
@ -707,10 +716,10 @@ End Sub
Sub print_basket()
'SHCONFIG.Cells(6, 2) = 1
If shConfig.Cells(6, 2) = 0 Then
'Sheets("config").Cells(6, 2) = 1
If Sheets("config").Cells(6, 2) = 0 Then
dumping = True
shMonthView.Range("B32:Q10000").ClearContents
Worksheets("month").Range("B32:Q10000").ClearContents
Rows("20:31").Hidden = False
dumping = False
Exit Sub
@ -718,16 +727,16 @@ Sub print_basket()
Dim i As Long
Dim basket() As Variant
basket = Utils.SHTp_get_block(shMonthUpdate.Range("U1"))
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
dumping = True
shMonthView.Range("B32:Q10000").ClearContents
Worksheets("month").Range("B32:Q10000").ClearContents
For i = 1 To UBound(basket, 1)
shMonthView.Cells(31 + i, 2) = basket(i, 1)
shMonthView.Cells(31 + i, 6) = basket(i, 2)
shMonthView.Cells(31 + i, 12) = basket(i, 3)
shMonthView.Cells(31 + i, 17) = basket(i, 4)
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
Sheets("month").Cells(31 + i, 6) = basket(i, 2)
Sheets("month").Cells(31 + i, 12) = basket(i, 3)
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
Next i
Rows("21:31").Hidden = True
@ -742,26 +751,26 @@ Sub basket_pick(ByRef Target As Range)
Dim i As Long
build.part = shMonthView.Cells(Target.row, 2)
build.bill = rev_cust(shMonthView.Cells(Target.row, 6))
build.ship = rev_cust(shMonthView.Cells(Target.row, 12))
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 shMonthView.Cells(Target.row, 2) = "" Then
Do Until shMonthView.Cells(Target.row + i, 2) <> ""
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
shMonthView.Cells(Target.row + i, 2) = build.cbPart.value
shMonthView.Cells(Target.row + i, 6) = rev_cust(build.cbBill.value)
shMonthView.Cells(Target.row + i, 12) = rev_cust(build.cbShip.value)
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
@ -784,7 +793,7 @@ Sub get_edit_basket()
'ReDim b(basket_rows, 3)
i = 0
Do Until shMonthView.Cells(33 + i, 2) = ""
Do Until Worksheets("month").Cells(33 + i, 2) = ""
i = i + 1
Loop
i = i - 1
@ -795,14 +804,14 @@ Sub get_edit_basket()
i = 0
mix = 0
Do Until shMonthView.Cells(33 + i, 2) = ""
b(i, 0) = shMonthView.Cells(33 + i, 2)
b(i, 1) = shMonthView.Cells(33 + i, 6)
b(i, 2) = shMonthView.Cells(33 + i, 12)
b(i, 3) = shMonthView.Cells(33 + i, 17)
Do Until Worksheets("month").Cells(33 + i, 2) = ""
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
If b(i, 3) = "" Then b(i, 3) = 0
mix = mix + b(i, 3)
If Not Intersect(basket_touch, shMonthView.Cells(33 + i, 17)) Is Nothing Then
If Not Intersect(basket_touch, Worksheets("month").Cells(33 + i, 17)) Is Nothing Then
touch_mix = touch_mix + b(i, 3)
touch(i) = True
untouched = untouched - 1
@ -825,13 +834,13 @@ Sub get_edit_basket()
'put the mix plug back on the the sheet
For i = 0 To UBound(b, 1)
shMonthView.Cells(33 + i, 17) = b(i, 3)
Worksheets("month").Cells(33 + i, 17) = b(i, 3)
Next i
dumping = False
shMonthUpdate.Range("U2:X5000").ClearContents
Call Utils.SHTp_DumpVar(b, shMonthUpdate.Name, 2, 21, False, False, True)
Worksheets("_month").Range("U2:X5000").ClearContents
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
If Me.newpart Then
Me.build_json
@ -851,7 +860,7 @@ Sub post_adjust()
Dim jdoc As String
If Me.newpart Then
Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(2, 16))
Set adjust = JsonConverter.ParseJson(Sheets("_month").Cells(2, 16))
adjust("message") = Me.tbMCOM.text
adjust("tag") = Me.cbMTAG.text
jdoc = JsonConverter.ConvertToJson(adjust)
@ -859,8 +868,8 @@ Sub post_adjust()
If fail Then Exit Sub
Else
For i = 2 To 13
If shMonthUpdate.Cells(i, 16) <> "" Then
Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(i, 16))
If Sheets("_month").Cells(i, 16) <> "" Then
Set adjust = JsonConverter.ParseJson(Sheets("_month").Cells(i, 16))
adjust("message") = Me.tbMCOM.text
adjust("tag") = Me.cbMTAG.text
jdoc = JsonConverter.ConvertToJson(adjust)
@ -870,14 +879,14 @@ Sub post_adjust()
Next i
End If
shOrders.Select
'shMonthView.Visible = xlHidden
Sheets("Orders").Select
'Worksheets("month").Visible = xlHidden
End Sub
Sub build_new()
shConfig.Cells(5, 2) = 1
Worksheets("config").Cells(5, 2) = 1
Dim i As Long
Dim j As Long
Dim basket() As Variant
@ -885,7 +894,7 @@ Sub build_new()
dumping = True
m = shMonthUpdate.Range("A2:O13").FormulaR1C1
m = Sheets("_month").Range("A2:O13").FormulaR1C1
For i = 1 To UBound(m, 1)
For j = 1 To UBound(m, 2)
@ -893,18 +902,20 @@ Sub build_new()
Next j
Next i
shMonthUpdate.Range("A2:O13") = m
Worksheets("_month").Range("A2:O13") = m
shMonthUpdate.Range("U2:X1000").ClearContents
shMonthUpdate.Range("Z2:AC1000").ClearContents
shMonthUpdate.Range("R2:S1000").ClearContents
Worksheets("_month").Range("U2:X1000").ClearContents
Worksheets("_month").Range("Z2:AC1000").ClearContents
Worksheets("_month").Range("R2:S1000").ClearContents
Call Me.load_sheet
'Call Me.set_sheet
'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
basket = Utils.SHTp_get_block(shMonthUpdate.Range("U1"))
shMonthView.Cells(32, 2) = basket(1, 1)
shMonthView.Cells(32, 6) = basket(1, 2)
shMonthView.Cells(32, 12) = basket(1, 3)
shMonthView.Cells(32, 17) = basket(1, 4)
basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
Sheets("month").Cells(32, 2) = basket(1, 1)
Sheets("month").Cells(32, 6) = basket(1, 2)
Sheets("month").Cells(32, 12) = basket(1, 3)
Sheets("month").Cells(32, 17) = basket(1, 4)
Call Me.print_basket
dumping = False
@ -923,8 +934,8 @@ Sub new_part()
'---------build customer mix-------------------------------------------------------------------
cust = Utils.SHTp_Get(shMonthUpdate.Name, 1, 27, True)
If Not Utils.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
cust = x.SHTp_Get("_month", 1, 27, True)
If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
MsgBox ("error building customer mix")
End If
@ -938,49 +949,49 @@ Sub new_part()
dumping = True
shMonthView.Range("B33:Q10000").ClearContents
Worksheets("month").Range("B33:Q10000").ClearContents
For i = 1 To UBound(cust, 2)
shMonthView.Cells(32 + i, 2) = part.cbPart.value
shMonthView.Cells(32 + i, 6) = cust(0, i)
shMonthView.Cells(32 + i, 12) = cust(1, i)
shMonthView.Cells(32 + i, 17) = CDbl(cust(2, i))
Sheets("month").Cells(32 + i, 2) = part.cbPart.value
Sheets("month").Cells(32 + i, 6) = cust(0, i)
Sheets("month").Cells(32 + i, 12) = cust(1, i)
Sheets("month").Cells(32 + i, 17) = CDbl(cust(2, i))
Next i
shConfig.Cells(7, 2) = 1
Sheets("config").Cells(7, 2) = 1
'------copy revised basket to _month storage---------------------------------------------------
i = 0
Do Until shMonthView.Cells(33 + i, 2) = ""
Do Until Worksheets("month").Cells(33 + i, 2) = ""
i = i + 1
Loop
i = i - 1
If i = -1 Then i = 0
ReDim b(i, 3)
i = 0
Do Until shMonthView.Cells(33 + i, 2) = ""
b(i, 0) = shMonthView.Cells(33 + i, 2)
b(i, 1) = shMonthView.Cells(33 + i, 6)
b(i, 2) = shMonthView.Cells(33 + i, 12)
b(i, 3) = shMonthView.Cells(33 + i, 17)
Do Until Worksheets("month").Cells(33 + i, 2) = ""
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
If b(i, 3) = "" Then b(i, 3) = 0
i = i + 1
Loop
shMonthUpdate.Range("U2:AC10000").ClearContents
Call Utils.SHTp_DumpVar(b, shMonthUpdate.Name, 2, 21, False, False, True)
Call Utils.SHTp_DumpVar(b, shMonthUpdate.Name, 2, 26, False, False, True)
Worksheets("_month").Range("U2:AC10000").ClearContents
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
'------reset volume to copy base to forecsat and clear base------------------------------------
units = shMonthUpdate.Range("A2:E13").FormulaR1C1
price = shMonthUpdate.Range("F2:J13").FormulaR1C1
sales = shMonthUpdate.Range("K2:O13").FormulaR1C1
units = Sheets("_month").Range("A2:E13").FormulaR1C1
price = Sheets("_month").Range("F2:J13").FormulaR1C1
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
tunits = Range("B18:F18")
tprice = Range("H18:L18")
tsales = Range("N18:R18")
ReDim adjust(12)
Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
For i = 1 To 12
'volume
units(i, 5) = units(i, 2)
@ -1007,13 +1018,13 @@ Sub new_part()
'-------------push revised arrays back to _month, not revertable-------------------------------
shMonthUpdate.Range("A2:E13") = units
shMonthUpdate.Range("F2:J13") = price
shMonthUpdate.Range("K2:o13") = sales
Worksheets("_month").Range("A2:E13") = units
Worksheets("_month").Range("F2:J13") = price
Worksheets("_month").Range("K2:o13") = sales
'force basket to show to demonstrate the part was changed
shConfig.Cells(6, 2) = 1
Sheets("config").Cells(6, 2) = 1
Call Me.print_basket
dumping = False
@ -1021,7 +1032,7 @@ End Sub
Function newpart() As Boolean
If shConfig.Cells(7, 2) = 1 Then
If Worksheets("config").Cells(7, 2) = 1 Then
newpart = True
Else
newpart = False

14
VBA/openf.frm
View File

@ -25,7 +25,7 @@ Private Sub cbOK_Click()
openf.Caption = "retrieving data......"
Call handler.pg_main_workset(cbDSM.value)
shOrders.PivotTables("ptOrders").PivotCache.Refresh
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
Application.StatusBar = False
openf.Hide
@ -34,10 +34,18 @@ End Sub
Private Sub UserForm_Activate()
'handler.server = "http://192.168.1.69:3000"
handler.server = shConfig.Cells(1, 2)
handler.server = Sheets("config").Cells(1, 2)
Dim x As New TheBigOne
Dim d() As String
openf.Caption = "Select a DSM"
cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value
d = x.SHTp_Get("reps", 1, 1, True)
For i = 1 To UBound(d, 2)
Call cbDSM.AddItem(d(0, i))
Next i
End Sub

BIN
VBA/openf.frx
View File

Binary file not shown.

4
VBA/part.frm
View File

@ -39,7 +39,9 @@ End Sub
Private Sub UserForm_Activate()
useval = False
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
End Sub

BIN
VBA/part.frx
View File

Binary file not shown.

26
VBA/shOrders.cls → VBA/pivot.cls
View File

@ -2,23 +2,26 @@ VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shOrders"
Attribute VB_Name = "pivot"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Sub Worksheet_Activate()
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables("ptOrders")
Dim intersec As Range
Set intersec = Intersect(Target, pt.DataBodyRange)
If intersec Is Nothing Then
If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
Exit Sub
ElseIf intersec.address <> Target.address Then
End If
On Error GoTo nopiv
If Target.Cells.PivotTable Is Nothing Then
Exit Sub
End If
@ -35,8 +38,10 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Dim cd As Object
Dim dd As Object
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim wapi As New Windows_API
Set ri = Target.Cells.PivotCell.RowItems
Set ci = Target.Cells.PivotCell.ColumnItems
@ -46,6 +51,7 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Set cd = Target.Cells.PivotTable.ColumnFields
ReDim handler.sc(ri.Count, 1)
Set pt = Target.Cells.PivotCell.PivotTable
handler.sql = ""
handler.jsql = ""
@ -63,6 +69,8 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Call handler.load_config
Call handler.load_fpvt
nopiv:
End Sub

25
VBA/shWalk.cls → VBA/pivot1.cls
View File

@ -2,22 +2,26 @@ VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shWalk"
Attribute VB_Name = "pivot1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Sub Worksheet_Activate()
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables("ptWalk")
Dim intersec As Range
Set intersec = Intersect(Target, pt.DataBodyRange)
If intersec Is Nothing Then
If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
Exit Sub
ElseIf intersec.address <> Target.address Then
End If
On Error GoTo nopiv
If Target.Cells.PivotTable Is Nothing Then
Exit Sub
End If
@ -34,8 +38,10 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Dim cd As Object
Dim dd As Object
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim wapi As New Windows_API
Set ri = Target.Cells.PivotCell.RowItems
Set ci = Target.Cells.PivotCell.ColumnItems
@ -45,6 +51,7 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Set cd = Target.Cells.PivotTable.ColumnFields
ReDim handler.sc(ri.Count, 1)
Set pt = Target.Cells.PivotCell.PivotTable
handler.sql = ""
handler.jsql = ""
@ -62,6 +69,8 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean
Call handler.load_config
Call handler.load_fpvt
nopiv:
End Sub

9
VBA/shConfig.cls
View File

@ -1,9 +0,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shConfig"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True

9
VBA/shData.cls
View File

@ -1,9 +0,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True

9
VBA/shMonthUpdate.cls
View File

@ -1,9 +0,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shMonthUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True

9
VBA/shSupportingData.cls
View File

@ -1,9 +0,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shSupportingData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True

67
build/build_forecast.sql
View File

@ -122,7 +122,7 @@ baseline AS (
-----when null, greatest/least is just going to act like coalesce
,greatest(least(o.sdate,gld.edat),gld.sdat) sdate
,ss.ssyr sseas
,'b24' "version"
,'b23' "version"
,'actuals' iter
FROM
rlarp.osm o
@ -135,12 +135,11 @@ baseline AS (
WHERE
(
--base period orders booked....
o.odate BETWEEN '2018-06-01' AND '2019-05-31'
o.odate BETWEEN '2022-06-01' AND '2023-03-01'
--...or any open orders currently booked before cutoff....
--OR (o.calc_status IN ('OPEN','BACKORDER') and o.odate < '2023-03-01')
OR (o.calc_status IN ('OPEN','BACKORDER') and o.odate < '2023-03-01')
--...or anything that shipped in that period
--OR ((o.fspr BETWEEN '1901' AND '1912' OR o.fspr = '0000') AND o.sdate < '2023-03-01')
OR (o.fspr BETWEEN '1901' AND '1912')
OR ((o.fspr BETWEEN '2301' AND '2309' OR o.fspr = '0000') AND o.sdate < '2023-03-01')
)
AND fs_line = '41010'
AND calc_status <> 'CANCELED'
@ -273,15 +272,15 @@ baseline AS (
,o.calc_status
,o.flag
,o.odate + interval '1 year' odate
,o.oseas + 5 rseas
,o.oseas + 1 rseas
,o.rdate + interval '1 year' rdate
,o.rseas + 5 rseas
,o.rseas + 1 rseas
,o.pdate + interval '1 year' pdate
,o.pseas + 5 pseas
,o.pseas + 1 pseas
-----when null, greatest/least is just going to act like coalesce
,greatest(least(o.sdate,gld.edat),gld.sdat) + interval '1 year' sdate
,ss.ssyr sseas
,'b24' "version"
,'b23' "version"
,'actuals_plug' iter
FROM
rlarp.osm o
@ -290,16 +289,15 @@ baseline AS (
LEFT OUTER JOIN rlarp.gld ss ON
greatest(least(o.sdate,gld.edat),gld.sdat) + interval '1 year' BETWEEN ss.sdat AND ss.edat
WHERE
false
--o.odate BETWEEN '2022-03-01' AND '2022-05-31'
--AND fs_line = '41010'
--AND calc_status <> 'CANCELED'
--AND NOT (calc_status = 'CLOSED' AND flag = 'REMAINDER')
----OR (
---- (o.fspr BETWEEN '2209' AND '2212' OR o.fspr = '0000')
---- AND o.sdate BETWEEN '2022-03-01' AND '2022-05-31'
----)
--AND version = 'ACTUALS'
o.odate BETWEEN '2022-03-01' AND '2022-05-31'
AND fs_line = '41010'
AND calc_status <> 'CANCELED'
AND NOT (calc_status = 'CLOSED' AND flag = 'REMAINDER')
--OR (
-- (o.fspr BETWEEN '2209' AND '2212' OR o.fspr = '0000')
-- AND o.sdate BETWEEN '2022-03-01' AND '2022-05-31'
--)
AND version = 'ACTUALS'
GROUP BY
o.fspr
,plnt
@ -434,7 +432,7 @@ baseline AS (
-----when null, greatest/least is just going to act like coalesce
,greatest(least(o.sdate,gld.edat),gld.sdat) sdate
,ss.ssyr sseas
,'b24' "version"
,'b23' "version"
,'forecast_plug' iter
FROM
rlarp.osmp o
@ -481,11 +479,11 @@ SELECT
,o."dilin#"
,o.quoten
,o.quotel
,o.dcodat + interval '5 years' --incremented
,o.ddqdat + interval '5 years' --incremented
,o.dcodat + interval '1 year' --incremented
,o.ddqdat + interval '1 year' --incremented
,o.dcmdat
,o.fesdat
,o.dhidat + interval '5 years' --incremented
,o.dhidat + interval '1 year' --incremented
,o.fesind
,o.dhpost
,gld.fspr --incremented
@ -569,23 +567,22 @@ SELECT
,o.fb_cst_loc_fut
,o.calc_status
,o.flag
,o.odate + interval '5 years' --incremented
,o.oseas + 5 --incremented
,o.rdate + interval '5 years' --incremented
,o.rseas + 5 --incremented
,o.pdate + interval '5 years' --incremented
,o.pseas + 5 --incremented
,o.sdate + interval '5 years' --incremented
,o.sseas + 5 --incremented
,'b24' "version"
,o.odate + interval '1 year' --incremented
,o.oseas + 1 --incremented
,o.rdate + interval '1 year' --incremented
,o.rseas + 1 --incremented
,o.pdate + interval '1 year' --incremented
,o.pseas + 1 --incremented
,o.sdate + interval '1 year' --incremented
,o.sseas + 1 --incremented
,'b23' "version"
,'copy' iter
FROM
baseline o
LEFT OUTER JOIN rlarp.gld ON
(o.sdate + interval '5 years') BETWEEN gld.sdat and gld.edat
(o.sdate + interval '1 year') BETWEEN gld.sdat and gld.edat
WHERE
true
--o.odate + interval '5 years' >= '2023-06-01'
o.odate + interval '1 year' >= '2023-06-01'
)
--INSERT INTO rlarp.osmf
SELECT

3
build/convert_pool_all.sql
View File

@ -127,8 +127,7 @@ SELECT
FROM
rlarp.osm_pool
WHERE
true;
--substring(iter,1,7) <> 'actuals';
version <> 'actuals';
-------need to set item master values before other things-----------
UPDATE

10
build/rebuild_script.sh
View File

@ -1,9 +1,7 @@
#!/bin/bash
#$PG -f ./build_stage.sql;
#$PG -f ./build_rolling.sql;
$PG -f ./build/build_forecast.sql
$PG -f ./build/snap_itemm.sql;
$PG -f ./build/snap_cost_current.sql;
$PG -f ./build/snap_customer.sql;
$PG -f ./build/build_pool.sql;
$PG -c "CALL rlarp.convert_pool_all();"
$PG -f ./snap_itemm.sql;
$PG -f ./snap_cost_current.sql;
$PG -f ./snap_customer.sql;
$PG -f ./build_pool.sql;

13
inquirey/osmf_months.sql
View File

@ -1,16 +1,15 @@
SELECT
--o.glec
to_char(CASE WHEN extract(month FROM o.odate) >= 6 THEN -5 ELSE 7 END + extract(month FROM o.odate),'FM00')||' - '||to_char(o.odate,'TMMon') order_month
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2019 AND iter = 'actuals'),0) act2019
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2019 AND iter = 'actuals_plug'),0) act2019_plug
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2019 ),0) total_baseline
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2024 AND version = 'b24'),0) plan2024
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2024 ),0) full2024
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2023 AND iter = 'actuals'),0) act2023
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2023 AND iter = 'actuals_plug'),0) act2023_plug
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2023 AND version IN ('actuals','15mo')),0) total_baseline
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE oseas = 2024 AND version = 'b23'),0) plan2024
FROM
rlarp.osmf o
WHERE
--oseas IN (2023,2024)
substring(glec,1,1) <= '2'
oseas IN (2023,2024)
AND substring(glec,1,1) <= '2'
--AND quota_rep_descr = 'COLIN MAXWELL'
GROUP BY
ROLLUP (

22
inquirey/osmf_months_shipped.sql
View File

@ -1,22 +0,0 @@
SELECT
--o.glec
to_char(CASE WHEN extract(month FROM o.sdate) >= 6 THEN -5 ELSE 7 END + extract(month FROM o.sdate),'FM00')||' - '||to_char(o.sdate,'TMMon') order_month
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2019 AND version IN ('b24') AND iter = 'actuals'),0) act2019
--,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2019 AND version IN ('b24') AND iter = 'actuals_plug'),0) act2019
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2019 AND version IN ('b24')),0) total_baseline
,ROUND(SUM(fb_val_loc * r_rate) FILTER (WHERE sseas = 2024 ),0) plan2024
FROM
rlarp.osmf o
WHERE
true
--sseas IN (2023,2024)
--AND substring(glec,1,1) <= '2'
--AND quota_rep_descr = 'COLIN MAXWELL'
GROUP BY
ROLLUP (
--o.glec,
to_char(CASE WHEN extract(month FROM o.sdate) >= 6 THEN -5 ELSE 7 END + extract(month FROM o.sdate),'FM00')||' - '||to_char(o.sdate,'TMMon')
)
ORDER BY
--o.glec,
order_month

19
route_sql/scenario_package.sql
View File

@ -36,8 +36,7 @@ FROM
rlarp.osm_pool
WHERE
where_clause
--quota_rep_descr = 'MATTHEW STAAL'
AND order_season IN (2019,2024)
AND order_season IN (2023,2024)
GROUP BY
order_season
,order_month
@ -95,14 +94,14 @@ GROUP BY
SELECT
order_month
,seq
,SUM(units) FILTER (WHERE order_season = 2019) "2023 qty"
,SUM(units) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan')) "2024 base qty"
,SUM(units) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan')) "2024 adj qty"
,SUM(units) FILTER (WHERE order_season = 2024) "2024 tot qty"
,SUM(value_usd) FILTER (WHERE order_season = 2019) "2023 value_usd"
,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan')) "2024 base value_usd"
,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan')) "2024 adj value_usd"
,SUM(value_usd) FILTER (WHERE order_season = 2024) "2024 tot value_usd"
,SUM(units) FILTER (WHERE order_season = 2023) "2023 qty"
,SUM(units) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan')) "2024 base qty"
,SUM(units) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan')) "2024 adj qty"
,SUM(units) FILTER (WHERE order_season = 2024) "2024 tot qty"
,SUM(value_usd) FILTER (WHERE order_season = 2023) "2023 value_usd"
,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter IN ('copy','short ship','bad_ship','plan')) "2024 base value_usd"
,SUM(value_usd) FILTER (WHERE order_season = 2024 AND iter NOT IN ('copy','short ship','bad_ship','plan')) "2024 adj value_usd"
,SUM(value_usd) FILTER (WHERE order_season = 2024) "2024 tot value_usd"
FROM
months
GROUP BY