plcore upload, and in-spreadsheet evaluation (Extract)
This commit is contained in:
parent
eb630686aa
commit
4dc88d8faf
350
PriceLists.bas
350
PriceLists.bas
@ -1,4 +1,6 @@
|
|||||||
Attribute VB_Name = "PriceLists"
|
Attribute VB_Name = "PriceLists"
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
Sub extract_price_matrix_suff()
|
Sub extract_price_matrix_suff()
|
||||||
|
|
||||||
'------------------------------------setup-------------------------------------------------
|
'------------------------------------setup-------------------------------------------------
|
||||||
@ -6,8 +8,15 @@ Sub extract_price_matrix_suff()
|
|||||||
Dim wapi As New Windows_API
|
Dim wapi As New Windows_API
|
||||||
Dim x As New TheBigOne
|
Dim x As New TheBigOne
|
||||||
Dim tbl() As Variant
|
Dim tbl() As Variant
|
||||||
|
Dim lists() As String
|
||||||
|
Dim pcol() As Long
|
||||||
Dim unp() As String
|
Dim unp() As String
|
||||||
Dim unv() As Variant
|
Dim unv() As Variant
|
||||||
|
Dim onelist() As String
|
||||||
|
Dim i As Long
|
||||||
|
Dim l As Long
|
||||||
|
Dim j As Long
|
||||||
|
|
||||||
Dim unps() As String
|
Dim unps() As String
|
||||||
Dim sql As String
|
Dim sql As String
|
||||||
Dim error As String
|
Dim error As String
|
||||||
@ -18,177 +27,116 @@ Sub extract_price_matrix_suff()
|
|||||||
Dim new_sh As Worksheet
|
Dim new_sh As Worksheet
|
||||||
Dim ws As Worksheet
|
Dim ws As Worksheet
|
||||||
Dim cp As CustomProperty
|
Dim cp As CustomProperty
|
||||||
|
|
||||||
'------------------------------------selection-------------------------------------------------
|
|
||||||
|
|
||||||
Set ini = Application.Selection
|
Set ini = Application.Selection
|
||||||
|
|
||||||
Selection.CurrentRegion.Select
|
Selection.CurrentRegion.Select
|
||||||
|
|
||||||
Set orig = Application.Selection
|
Set orig = Application.Selection
|
||||||
|
|
||||||
'--------------------------------test if valid price matrix------------------------------
|
unp = unpivot_current_sheet(lists, pcol)
|
||||||
|
|
||||||
If Selection.Cells.Count = 1 Then
|
|
||||||
MsgBox ("selection is not a table")
|
|
||||||
orig.Select
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
tbl = Selection
|
|
||||||
|
|
||||||
If UBound(tbl, 1) < 2 Then error = "selection is not a valid price matrix"
|
|
||||||
If UBound(tbl, 2) <> 9 Then error = "selection is not a valid price matrix"
|
|
||||||
|
|
||||||
If Not error = "" Then
|
|
||||||
MsgBox (error)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
'-----------------------------unpivot price matrix into new array-----------------------------
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
Dim j As Long
|
|
||||||
Dim k As Long
|
|
||||||
Dim m As Long
|
|
||||||
k = 0
|
|
||||||
ReDim unp(9, (UBound(tbl, 1) - 1) * 3)
|
|
||||||
'iterate through rows
|
|
||||||
For i = 2 To UBound(tbl, 1)
|
|
||||||
'3 iterations per row
|
|
||||||
For m = 0 To 2
|
|
||||||
k = k + 1
|
|
||||||
'part
|
|
||||||
unp(0, k) = tbl(i, 1) 'stlye code
|
|
||||||
unp(1, k) = tbl(i, 2) 'color tier
|
|
||||||
unp(2, k) = tbl(i, 3) 'branding
|
|
||||||
unp(3, k) = tbl(i, 4) 'kit
|
|
||||||
unp(4, k) = tbl(i, 5) 'suffix
|
|
||||||
unp(5, k) = tbl(i, 6) 'container
|
|
||||||
unp(6, k) = m + 1 'volume break
|
|
||||||
unp(7, k) = tbl(i, 7 + m) 'price
|
|
||||||
unp(8, k) = i 'orig row
|
|
||||||
unp(9, k) = 7 + m 'orig col
|
|
||||||
Next m
|
|
||||||
Next i
|
|
||||||
unp(0, 0) = "stlc"
|
|
||||||
unp(1, 0) = "coltier"
|
|
||||||
unp(2, 0) = "branding"
|
|
||||||
unp(3, 0) = "accs"
|
|
||||||
unp(4, 0) = "suffix"
|
|
||||||
unp(5, 0) = "container"
|
|
||||||
unp(6, 0) = "volume"
|
|
||||||
unp(7, 0) = "price"
|
|
||||||
unp(8, 0) = "orig_row"
|
|
||||||
unp(9, 0) = "orig_col"
|
|
||||||
|
|
||||||
|
|
||||||
If Not x.TBLp_TestNumeric(unp, 7) Then
|
|
||||||
MsgBox ("price is text")
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
unp = x.TBLp_Transpose(unp)
|
|
||||||
unv = x.TBLp_StringToVar(unp)
|
|
||||||
|
|
||||||
'-------------------------prepare sql to upload---------------------------------------------------------------
|
|
||||||
|
|
||||||
'sql = x.SQLp_build_sql_values(unp, False, True, Db2, False)
|
|
||||||
sql = x.json_from_table(unv, "", False)
|
|
||||||
sql = "SELECT * FROM rlarp.build_f20_suff($$" & sql & "$$::jsonb)"
|
|
||||||
Call wapi.ClipBoard_SetData(sql)
|
|
||||||
|
|
||||||
'If MsgBox(sql, vbOKCancel, "continue with build?") = vbCancel Then Exit Sub
|
|
||||||
'Exit Sub
|
|
||||||
login.Show
|
login.Show
|
||||||
If Not login.proceed Then Exit Sub
|
If Not login.proceed Then Exit Sub
|
||||||
|
|
||||||
|
|
||||||
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") Then
|
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") Then
|
||||||
MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring)
|
MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
cms_pl = x.ADOp_SelectS(0, sql, True, 50000, True)
|
|
||||||
|
|
||||||
Call x.ADOp_CloseCon(0)
|
|
||||||
|
|
||||||
'Exit Sub
|
|
||||||
|
|
||||||
'--------------------------setup an output sheet if necessary-------------------------------
|
|
||||||
|
|
||||||
For Each ws In Application.Worksheets
|
|
||||||
For Each cp In ws.CustomProperties
|
|
||||||
If cp.Name = "spec_name" And cp.value = "price_list" Then
|
|
||||||
Set new_sh = ws
|
|
||||||
Exit For
|
|
||||||
End If
|
|
||||||
Next cp
|
|
||||||
Next ws
|
|
||||||
|
|
||||||
If new_sh Is Nothing Then
|
|
||||||
Set new_sh = Application.Worksheets.Add
|
|
||||||
Call new_sh.CustomProperties.Add("spec_name", "price_list")
|
|
||||||
new_sh.Name = "Price Build"
|
|
||||||
End If
|
|
||||||
|
|
||||||
'-------------------------dump contents------------------------------------------------------
|
|
||||||
|
|
||||||
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
|
|
||||||
new_sh.Select
|
|
||||||
ActiveSheet.Cells(1, 1).CurrentRegion.Select
|
|
||||||
Selection.Columns.AutoFit
|
|
||||||
|
|
||||||
Rows("1:1").Select
|
|
||||||
With ActiveWindow
|
|
||||||
.SplitColumn = 0
|
|
||||||
.SplitRow = 1
|
|
||||||
End With
|
|
||||||
ActiveWindow.FreezePanes = True
|
|
||||||
|
|
||||||
|
|
||||||
'--------------------------format source cells for any build issues--------------------------------
|
|
||||||
|
|
||||||
orig.Worksheet.Select
|
|
||||||
|
|
||||||
With orig.Interior
|
With orig.Interior
|
||||||
.Pattern = xlNone
|
.Pattern = xlNone
|
||||||
.TintAndShade = 0
|
.TintAndShade = 0
|
||||||
.PatternTintAndShade = 0
|
.PatternTintAndShade = 0
|
||||||
End With
|
End With
|
||||||
|
|
||||||
'if a cell has even one valid hit, don't show an error
|
For l = 1 To UBound(lists)
|
||||||
'create a copy of tbl
|
'----------filter the main data set for each price lists (due to json_from_table taking forever on big tables)--------
|
||||||
'the default value for cell is error, if any good values are found, they stay
|
onelist = unp
|
||||||
|
Call x.TBLp_FilterSingle(onelist, 9, lists(l), True)
|
||||||
|
onelist = x.TBLp_Transpose(onelist)
|
||||||
|
unv = x.TBLp_StringToVar(onelist)
|
||||||
|
|
||||||
j = 0
|
'-------------------------prepare sql to upload---------------------------------------------------------------
|
||||||
For i = 1 To UBound(cms_pl, 1)
|
|
||||||
Select Case cms_pl(i, 15)
|
'sql = x.SQLp_build_sql_values(unp, False, True, Db2, False)
|
||||||
Case ""
|
sql = x.json_from_table(unv, "", False)
|
||||||
orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor = xlThemeColorAccent6
|
sql = "SELECT * FROM rlarp.plcore_fullcode_inq($$" & sql & "$$::jsonb)"
|
||||||
Case "No UOM Conversion"
|
Call wapi.ClipBoard_SetData(sql)
|
||||||
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
|
|
||||||
orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
|
'If MsgBox(sql, vbOKCancel, "continue with build?") = vbCancel Then Exit Sub
|
||||||
|
'Exit Sub
|
||||||
|
cms_pl = x.ADOp_SelectS(0, sql, True, 50000, True)
|
||||||
|
|
||||||
|
'--------------------------setup an output sheet if necessary-------------------------------
|
||||||
|
|
||||||
|
For Each ws In Application.Worksheets
|
||||||
|
For Each cp In ws.CustomProperties
|
||||||
|
If cp.Name = "spec_name" And cp.value = "price_list" Then
|
||||||
|
Set new_sh = ws
|
||||||
|
Exit For
|
||||||
End If
|
End If
|
||||||
Case "Inactive"
|
Next cp
|
||||||
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
|
Next ws
|
||||||
orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 20, 161)
|
|
||||||
End If
|
If new_sh Is Nothing Then
|
||||||
Case "No SKU"
|
Set new_sh = Application.Worksheets.Add
|
||||||
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
|
Call new_sh.CustomProperties.Add("spec_name", "price_list")
|
||||||
orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(20, 255, 161)
|
new_sh.Name = "Price Build"
|
||||||
End If
|
End If
|
||||||
End Select
|
|
||||||
'if the current row/column is OK, advance to the next row/column
|
'-------------------------dump contents------------------------------------------------------
|
||||||
|
|
||||||
|
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
|
||||||
|
new_sh.Select
|
||||||
|
ActiveSheet.Cells(1, 1).CurrentRegion.Select
|
||||||
|
Selection.Columns.AutoFit
|
||||||
|
|
||||||
|
Rows("1:1").Select
|
||||||
|
With ActiveWindow
|
||||||
|
.SplitColumn = 0
|
||||||
|
.SplitRow = 1
|
||||||
|
End With
|
||||||
|
ActiveWindow.FreezePanes = True
|
||||||
|
|
||||||
|
|
||||||
|
'--------------------------format source cells for any build issues--------------------------------
|
||||||
|
|
||||||
|
orig.Worksheet.Select
|
||||||
|
'if a cell has even one valid hit, don't show an error
|
||||||
|
'create a copy of tbl
|
||||||
|
'the default value for cell is error, if any good values are found, they stay
|
||||||
|
|
||||||
j = 0
|
j = 0
|
||||||
Do Until cms_pl(i, 13) <> cms_pl(i + j, 13) Or cms_pl(i, 14) <> cms_pl(i + j, 14)
|
For i = 1 To UBound(cms_pl, 1)
|
||||||
j = j + 1
|
Select Case cms_pl(i, 15)
|
||||||
If i + j >= UBound(cms_pl, 1) Then Exit Do
|
Case ""
|
||||||
Loop
|
orig.Worksheet.Cells(orig.row + cms_pl(i, 13), orig.column + cms_pl(i, 14)).Interior.ThemeColor = xlThemeColorAccent6
|
||||||
i = i + j - 1 '-1 becuase the "next i" will increment by 1 again
|
Case "No UOM Conversion"
|
||||||
Next i
|
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13), orig.column + cms_pl(i, 14)).Interior.ThemeColor <> xlThemeColorAccent6 Then
|
||||||
|
orig.Worksheet.Cells(orig.row + cms_pl(i, 13), orig.column + cms_pl(i, 14)).Interior.Color = RGB(255, 255, 161)
|
||||||
|
End If
|
||||||
|
Case "Inactive"
|
||||||
|
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13), orig.column + cms_pl(i, 14)).Interior.ThemeColor <> xlThemeColorAccent6 Then
|
||||||
|
orig.Worksheet.Cells(orig.row + cms_pl(i, 13), orig.column + cms_pl(i, 14)).Interior.Color = RGB(255, 20, 161)
|
||||||
|
End If
|
||||||
|
Case "No SKU"
|
||||||
|
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13), orig.column + cms_pl(i, 14)).Interior.ThemeColor <> xlThemeColorAccent6 Then
|
||||||
|
orig.Worksheet.Cells(orig.row + cms_pl(i, 13), orig.column + cms_pl(i, 14)).Interior.Color = RGB(20, 255, 161)
|
||||||
|
End If
|
||||||
|
End Select
|
||||||
|
'if the current row/column is OK, advance to the next row/column
|
||||||
|
j = 0
|
||||||
|
Do Until cms_pl(i, 13) <> cms_pl(i + j, 13) Or cms_pl(i, 14) <> cms_pl(i + j, 14)
|
||||||
|
j = j + 1
|
||||||
|
If i + j >= UBound(cms_pl, 1) Then Exit Do
|
||||||
|
Loop
|
||||||
|
i = i + j - 1 '-1 becuase the "next i" will increment by 1 again
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Dim cell As Range
|
||||||
|
|
||||||
|
Next l
|
||||||
|
|
||||||
Dim cell As Range
|
Call x.ADOp_CloseCon(0)
|
||||||
|
|
||||||
For Each cell In Application.Selection.Cells
|
For Each cell In Application.Selection.Cells
|
||||||
'if the cell fill is green, then a known good part was found, so cell to blank
|
'if the cell fill is green, then a known good part was found, so cell to blank
|
||||||
@ -209,6 +157,9 @@ Sub extract_price_matrix_suff()
|
|||||||
Selection.Columns(5).Interior.Pattern = xlNone
|
Selection.Columns(5).Interior.Pattern = xlNone
|
||||||
Selection.Columns(6).Interior.Pattern = xlNone
|
Selection.Columns(6).Interior.Pattern = xlNone
|
||||||
Selection.Rows(1).Interior.Pattern = xlNone
|
Selection.Rows(1).Interior.Pattern = xlNone
|
||||||
|
For i = 1 To UBound(pcol)
|
||||||
|
Selection.Columns(pcol(i) + 1).Interior.Pattern = xlNone
|
||||||
|
Next i
|
||||||
|
|
||||||
|
|
||||||
'----------------------------cleanup-------------------------------------------------------------
|
'----------------------------cleanup-------------------------------------------------------------
|
||||||
@ -469,3 +420,106 @@ PRICELIST_SHOW:
|
|||||||
|
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Function unpivot_current_sheet(ByRef lists() As String, ByRef pcol() As Long) As String()
|
||||||
|
|
||||||
|
Dim x As New TheBigOne 'function library
|
||||||
|
Dim sh As Worksheet 'target worksheet
|
||||||
|
Dim big() As String 'all price lists in one array
|
||||||
|
Dim unpivot() As String 'unwrap the columns into volume level rows
|
||||||
|
Dim load() As String 'individual price list to be loaded
|
||||||
|
Dim pcount As Long 'count of price list
|
||||||
|
'Dim pcol() As Long 'hold the positions of each price list
|
||||||
|
ReDim pcol(30) 'size the array starting with 30 and trim later
|
||||||
|
ReDim lists(30)
|
||||||
|
Dim dcol() As Integer 'columns to be deleted
|
||||||
|
Dim typeflag() As String 'array of column types
|
||||||
|
Dim i As Long 'walks through each price list
|
||||||
|
Dim j As Long 'walks through each original row
|
||||||
|
Dim k As Long 'creates new rows for each price break
|
||||||
|
Dim m As Long 'row position in the new table
|
||||||
|
Dim sql As String
|
||||||
|
|
||||||
|
'-------identify the active sheet and load the contents to an array-----------
|
||||||
|
|
||||||
|
Set sh = ActiveSheet
|
||||||
|
big = x.SHTp_Get(sh.Name, 3, 1, True)
|
||||||
|
|
||||||
|
'------iterate through the column headers to identify the price lists---------
|
||||||
|
|
||||||
|
pcount = 0
|
||||||
|
For i = 0 To UBound(big, 1)
|
||||||
|
If big(i, 0) = "plist" Then
|
||||||
|
pcount = pcount + 1
|
||||||
|
pcol(pcount) = i
|
||||||
|
lists(pcount) = big(i, 1)
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
'------if no columns are labeled plist then exit------------------------------
|
||||||
|
|
||||||
|
If pcount = 0 Then Exit Function
|
||||||
|
ReDim Preserve pcol(pcount)
|
||||||
|
ReDim Preserve lists(pcount)
|
||||||
|
ReDim typeflag(9)
|
||||||
|
|
||||||
|
|
||||||
|
'----since there are 3 price columns, those will need transformed to 3 price rows per each original-----
|
||||||
|
ReDim load(11, UBound(big, 2) * 3 * pcount)
|
||||||
|
m = 1
|
||||||
|
'----set headers-----
|
||||||
|
load(0, 0) = "stlc"
|
||||||
|
load(1, 0) = "coltier"
|
||||||
|
load(2, 0) = "branding"
|
||||||
|
load(3, 0) = "accs"
|
||||||
|
load(4, 0) = "suffix"
|
||||||
|
load(5, 0) = "uomp"
|
||||||
|
load(6, 0) = "vol_uom"
|
||||||
|
load(7, 0) = "vol_qty"
|
||||||
|
load(8, 0) = "vol_price"
|
||||||
|
load(9, 0) = "listcode"
|
||||||
|
load(10, 0) = "orig_row"
|
||||||
|
load(11, 0) = "orig_col"
|
||||||
|
|
||||||
|
For pcount = 1 To UBound(pcol)
|
||||||
|
'-----populate------------
|
||||||
|
For i = 1 To UBound(big, 2)
|
||||||
|
'-----hard coded to number of price breaks (3)-------
|
||||||
|
For k = 0 To 2
|
||||||
|
load(0, m) = big(0, i)
|
||||||
|
load(1, m) = big(1, i)
|
||||||
|
load(2, m) = big(2, i)
|
||||||
|
load(3, m) = big(3, i)
|
||||||
|
load(4, m) = big(4, i)
|
||||||
|
'----position 3 is a bulk pallet so the default UOM needs hard coded to PLT-----
|
||||||
|
If k = 2 Then
|
||||||
|
load(5, m) = "PLT"
|
||||||
|
Else
|
||||||
|
load(5, m) = big(5, i)
|
||||||
|
End If
|
||||||
|
'----(3-k) should work out to 1st 2nd 3rd price colum----------------------------
|
||||||
|
'----the first column UOM is the default package, everything else is a pallet----
|
||||||
|
If k = 0 Then
|
||||||
|
load(6, m) = big(5, i)
|
||||||
|
Else
|
||||||
|
load(6, m) = "PLT"
|
||||||
|
End If
|
||||||
|
'----for now the volumes are always 1 of the unit of measure in colunm 6 above
|
||||||
|
load(7, m) = "1"
|
||||||
|
load(8, m) = Format(big(pcol(pcount) - (3 - k), i), "####0.00")
|
||||||
|
load(9, m) = big(pcol(pcount) - 0, i)
|
||||||
|
load(10, m) = i
|
||||||
|
load(11, m) = pcol(pcount) - (3 - k)
|
||||||
|
m = m + 1
|
||||||
|
Next k
|
||||||
|
Next i
|
||||||
|
Next pcount
|
||||||
|
|
||||||
|
If Not x.TBLp_TestNumeric(load, 8) Then
|
||||||
|
MsgBox ("price is text")
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
unpivot_current_sheet = load
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user