Attribute VB_Name = "targets" Option Explicit Public ws As Worksheet Public x As New TheBigOne Sub get_options() Dim res() As String Dim mold As String Set ws = ActiveSheet Dim sql As String mold = ws.Cells(2, 1) 'If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then Exit Sub sql = "SELECT * FROM rlarp.get_options('" & mold & "');" res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm") ws.Range("M1:P350").ClearContents Call x.SHTp_Dump(res, ws.Name, 1, 13, False, True, 15) sql = "SELECT * FROM rlarp.get_option_costs('" & mold & "');" res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm") ws.Range("C1:K350").ClearContents Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 8) Call x.ADOp_CloseCon(0) End Sub Sub combine_options() Dim mold As String Dim stack() As String Dim stackv() As Variant Dim res() As String Dim i As Long Dim j As Long Dim sql As String Dim json As String Set ws = ActiveSheet mold = ws.Cells(2, 1) stack = x.SHTp_GetString(ws.Range("L1")) stack = x.TBLp_Transpose(stack) stackv = x.TBLp_StringToVar(stack) json = x.json_from_table(stackv, "", False) sql = "SELECT * FROM rlarp.set_options($$" & vbCrLf & json & vbCrLf & "$$::jsonb)" res = x.ADOp_SelectS(0, sql, True, 5000, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm") Call x.ADOp_CloseCon(0) ws.Range("R1:AD5000").ClearContents Call x.SHTp_Dump(res, ws.Name, 1, 18, False, True) End Sub Sub save_targets() Dim path As String Dim opt() As String Dim tar() As String Dim ws As Worksheet Dim sql() As String Dim sqlt As String Dim targt As String Dim i As Long 'create 3 files: '* options listing '* list of targets as csv '* list of targets embedded in sql for merge Set ws = ActiveSheet opt = x.SHTp_Get(ws.Name, 1, 13, True) tar = x.SHTp_Get(ws.Name, 1, 18, True) path = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\options.csv" If Not x.FILEp_CreateCSV(path, opt) Then MsgBox ("file creation error") Exit Sub End If path = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\targ.csv" If Not x.FILEp_CreateCSV(path, tar) Then MsgBox ("file creation error") Exit Sub End If '--------------------mssql merge---------------------------- sql() = x.FILEp_GetTXT(Sheets("env").Cells(1, 2) & "\000\merge.sql", 1000) For i = LBound(sql, 2) To UBound(sql, 2) sqlt = sqlt & sql(0, i) & vbCrLf Next i targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 18, True), True, True, PostgreSQL, False, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N") sqlt = Replace(sqlt, "replace_this", targt) If Not x.FILEp_Create(Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\merge.sql", sqlt) Then Exit Sub End If '--------------------postgres merge---------------------------- sql() = x.FILEp_GetTXT(Sheets("env").Cells(1, 2) & "\000\merge.pg.sql", 1000) sqlt = "" For i = LBound(sql, 2) To UBound(sql, 2) sqlt = sqlt & sql(0, i) & vbCrLf Next i targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 18, True), True, True, PostgreSQL, False, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N") sqlt = Replace(sqlt, "replace_this", targt) If Not x.FILEp_Create(Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\merge.pg.sql", sqlt) Then Exit Sub End If 'Dim Foldername As String 'Foldername = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) 'Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus End Sub Sub get_options_old() Dim brd() As String Dim pck() As String Dim acc() As String Dim col() As String Dim sfx() As String Dim c As Object Dim mold As String Set ws = ActiveSheet mold = ws.Cells(2, 1) If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then Exit Sub brd = x.ADOp_SelectS(0, "select distinct substring(branding,1,1) ""Branding"", 0 ""Price"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True) pck = x.ADOp_SelectS(0, "select distinct uomp->>0 ""Packaging"", 0 ""Price"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True) acc = x.ADOp_SelectS(0, "select distinct accs_ps ""Accessories"", 0 ""Price"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True) col = x.ADOp_SelectS(0, "select distinct coltier ""Color Tier"", 0 ""Facor"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True) sfx = x.ADOp_SelectS(0, "select distinct suffix ""Suffix"" ,0 ""Factor"" from rlarp.itemmv where stlc = '" & mold & "'", True, 50, True) Call x.ADOp_CloseCon(0) ws.Range("E1:I35").ClearContents Call x.SHTp_Dump(brd, ws.Name, 1, 5, False, True) Call x.SHTp_Dump(pck, ws.Name, 6, 5, False, True) Call x.SHTp_Dump(acc, ws.Name, 13, 5, False, True) Call x.SHTp_Dump(col, ws.Name, 1, 8, False, True) Call x.SHTp_Dump(sfx, ws.Name, 16, 8, False, True) For Each c In ws.Range("F2:F30") If (IsNumeric(c.value) And c.value <> "") Then c.value = CDbl(c.value) Next c For Each c In ws.Range("I2:I30") If (IsNumeric(c.value) And c.value <> "") Then c.value = CDbl(c.value) Next c End Sub Sub push_options_old() Dim brd() As String Dim pkg() As String Dim acc() As String Dim col() As String Dim sfx() As String Dim mold As String Dim stack() As String Dim i As Long Dim j As Long Set ws = ActiveSheet mold = ws.Cells(2, 1) brd = x.SHTp_GetString(ws.Range("E1")) pkg = x.SHTp_GetString(ws.Range("E6")) acc = x.SHTp_GetString(ws.Range("E13")) col = x.SHTp_GetString(ws.Range("H1")) sfx = x.SHTp_GetString(ws.Range("H16")) j = 2 ReDim stack(3, UBound(brd, 2) + UBound(pkg, 2) + UBound(acc, 2) + UBound(col, 2) + UBound(sfx, 2) - 5 + 1) stack(0, 0) = "entity" stack(1, 0) = "attr" stack(2, 0) = "val" stack(3, 0) = "func" stack(0, 1) = "Anchor" stack(1, 1) = mold stack(2, 1) = ws.Cells(2, 2) stack(3, 1) = "Price" For i = 2 To UBound(brd, 2) stack(0, j) = "Branding" stack(1, j) = brd(1, i) stack(2, j) = brd(2, i) stack(3, j) = brd(2, 1) j = j + 1 Next i For i = 2 To UBound(pkg, 2) stack(0, j) = "Packaging" stack(1, j) = pkg(1, i) stack(2, j) = pkg(2, i) stack(3, j) = pkg(2, 1) j = j + 1 Next i For i = 2 To UBound(acc, 2) stack(0, j) = "Accessories" stack(1, j) = acc(1, i) stack(2, j) = acc(2, i) stack(3, j) = acc(2, 1) j = j + 1 Next i For i = 2 To UBound(col, 2) stack(0, j) = "Color Tier" stack(1, j) = col(1, i) stack(2, j) = col(2, i) stack(3, j) = col(2, 1) j = j + 1 Next i For i = 2 To UBound(sfx, 2) stack(0, j) = "Suffix" stack(1, j) = sfx(1, i) stack(2, j) = sfx(2, i) stack(3, j) = sfx(2, 1) j = j + 1 Next i ws.Range("L1:O100").ClearContents Call x.SHTp_Dump(stack, ws.Name, 1, 12, False, True, 14) End Sub