add major group filters

This commit is contained in:
Paul Trowbridge 2025-07-24 14:37:12 -04:00
parent 9ca4a7c57e
commit aafd771ea4

View File

@ -29,6 +29,7 @@ Sub ReadConfig()
Dim configPath As String
Dim reviewGroup As String
Dim regexPattern As String
Dim majg As String
Dim volumeCode As String
Dim statusCode As String
Dim fso As Object
@ -71,18 +72,21 @@ Sub ReadConfig()
regexPattern = ReadINI("Filter", "ProductFamilyRegex", configPath)
volumeCode = ReadINI("Filter", "VolumeUOM", configPath)
statusCode = ReadINI("Filter", "StatusCode", configPath)
majg = ReadINI("Filter", "MajorGroups", configPath)
' === 5. Handle empty values with fallback ===
If reviewGroup = "" Then reviewGroup = "(not defined)"
If regexPattern = "" Then regexPattern = "(not defined)"
If volumeCode = "" Then volumeCode = "GAL"
If statusCode = "" Then statusCode = "FALSE"
If majg = "" Then majg = ".*"
' === 6. Write results to Excel cells ===
Sheets("combine").Range("A2").value = reviewGroup
Sheets("combine").Range("A5").value = regexPattern
Sheets("combine").Range("A8").value = volumeCode
Sheets("combine").Range("A11").value = statusCode
Sheets("combine").Range("A14").value = majg
' === 7. Load options ===
Call LoadOptionsAndCosts
@ -106,6 +110,7 @@ Sub WriteConfig()
' Values to write
Dim reviewGroup As String
Dim regexPattern As String
Dim majg As String
On Error GoTo HandleError
@ -135,6 +140,8 @@ Sub WriteConfig()
If regexPattern = "" Then regexPattern = ".*" ' default fallback
volumeCode = trim(Sheets("combine").Cells(8, 1).value)
statusCode = trim(Sheets("combine").Cells(11, 1).value)
majg = trim(Sheets("combine").Cells(14, 1).value)
If majg = "" Then majg = ".*" ' default fallback
' === 4. Ensure target folder exists ===
If Not fso.FolderExists(targetFolder) Then
@ -148,6 +155,7 @@ Sub WriteConfig()
ts.WriteLine "ProductFamilyRegex = " & regexPattern
ts.WriteLine "VolumeUOM = " & volumeCode
ts.WriteLine "StatusCode = " & statusCode
ts.WriteLine "MajorGroups = " & majg
ts.Close
' === 6. Done silently ===
@ -221,6 +229,7 @@ Sub LoadOptionsAndCosts()
Dim csvTable As Variant
Dim optionsJSON As String
Dim pricegroup As String
Dim majg As String
Dim folder As String
Dim sql As String
Dim fpath As String
@ -235,6 +244,7 @@ Sub LoadOptionsAndCosts()
' === Read mold (regex) and folder ===
pricegroup = trim(ws.Cells(ROW_REGEX, COL_REGEX).value)
majg = ws.Range("A14").value
folder = trim(ws.Cells(ROW_FOLDER, COL_FOLDER).value)
If pricegroup = "" Then
@ -264,7 +274,9 @@ Sub LoadOptionsAndCosts()
End If
' === 2. Get option costs ===
sql = "SELECT * FROM rlarp.get_option_costs_priceg('" & Replace(pricegroup, "'", "''") & "') " & _
sql = "SELECT * FROM rlarp.get_option_costs_priceg(" & _
"'" & Replace(pricegroup, "'", "''") & "', " & _
"'" & Replace(majg, "'", "''") & "') " & _
"ORDER BY branding, coltier, uomp;"
res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _
"usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
@ -445,6 +457,7 @@ Sub BuildOptionsAndCosts()
Dim i As Long
Dim x As New TheBigOne
Dim fso As Object
Dim majg As String
On Error GoTo HandleError
@ -454,6 +467,7 @@ Sub BuildOptionsAndCosts()
' === Read mold (regex) and folder ===
pricegroup = trim(ws.Cells(ROW_REGEX, COL_REGEX).value)
folder = trim(ws.Cells(ROW_FOLDER, COL_FOLDER).value)
majg = ws.Range("A14").value
If pricegroup = "" Then
MsgBox "Error: No regex pattern provided in cell A5.", vbExclamation
@ -478,6 +492,7 @@ Sub BuildOptionsAndCosts()
' === 1. Call Postgres for merged options ===
sql = "SELECT * FROM rlarp.get_options_merged(" & _
"'" & Replace(pricegroup, "'", "''") & "', " & _
"'" & Replace(majg, "'", "''") & "', " & _
"'" & Replace(optionsJSON, "'", "''") & "');"
res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _
@ -486,7 +501,9 @@ Sub BuildOptionsAndCosts()
Call x.SHTp_Dump(res, ws.Name, ws.Cells(ws.Rows.Count, 16).End(xlUp).row, 16, False, True, 2)
' === 2. Get option costs ===
sql = "SELECT * FROM rlarp.get_option_costs_priceg('" & Replace(pricegroup, "'", "''") & "') " & _
sql = "SELECT * FROM rlarp.get_option_costs_priceg(" & _
"'" & Replace(pricegroup, "'", "''") & "', " & _
"'" & Replace(majg, "'", "''") & "') " & _
"ORDER BY branding, coltier, uomp;"
res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _
"usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
@ -517,6 +534,7 @@ Sub GetProductInfo()
Dim sql As String
Dim x As New TheBigOne
Dim qry As Worksheet
Dim majg As String
On Error GoTo HandleError
@ -526,6 +544,7 @@ Sub GetProductInfo()
' === Read product code from A5 ===
productCode = trim(ws.Cells(ROW_INPUT, COL_INPUT).value)
volumeCode = trim(ws.Cells(8, 1).value)
majg = ws.Range("A14").value
If productCode = "" Then
MsgBox "Error: No product code provided in cell A5.", vbExclamation
@ -535,7 +554,8 @@ Sub GetProductInfo()
' === Build SQL to call Postgres function ===
sql = "SELECT * FROM rlarp.get_product_info(" & _
"'" & Replace(productCode, "'", "''") & "', " & _
"'" & Replace(volumeCode, "'", "''") & "');"
"'" & Replace(volumeCode, "'", "''") & "', " & _
"'" & Replace(majg, "'", "''") & "');"
' === Call Postgres ===
res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, _