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

get rid of suffix column and include use accs instead of kit

Browse Source
This commit is contained in:
Paul Trowbridge 2020-10-28 11:22:14 -04:00
parent cc4bd12720
commit 9dcf8ac310
1 changed files with 25 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
FL.bas
View File

@ -1240,7 +1240,7 @@ Sub extract_price_matrix_r2()
tbl = Selection tbl = Selection
If UBound(tbl, 1) < 2 Then error = "selection is not a valid price matrix" 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 UBound(tbl, 2) <> 8 Then error = "selection is not a valid price matrix"
If Not error = "" Then If Not error = "" Then
MsgBox (error) MsgBox (error)
@ -1254,7 +1254,7 @@ Sub extract_price_matrix_r2()
Dim k As Long Dim k As Long
Dim m As Long Dim m As Long
k = 0 k = 0
ReDim unp(9, (UBound(tbl, 1) - 1) * 3) ReDim unp(8, (UBound(tbl, 1) - 1) * 3)
'iterate through rows 'iterate through rows
For i = 2 To UBound(tbl, 1) For i = 2 To UBound(tbl, 1)
'3 iterations per row '3 iterations per row
@ -1265,24 +1265,24 @@ Sub extract_price_matrix_r2()
unp(1, k) = tbl(i, 2) 'color tier unp(1, k) = tbl(i, 2) 'color tier
unp(2, k) = tbl(i, 3) 'branding unp(2, k) = tbl(i, 3) 'branding
unp(3, k) = tbl(i, 4) 'kit unp(3, k) = tbl(i, 4) 'kit
unp(4, k) = tbl(i, 5) 'suffix 'unp(4, k) = tbl(i, 5) 'suffix
unp(5, k) = tbl(i, 6) 'container unp(4, k) = tbl(i, 5) 'container
unp(6, k) = m + 1 'volume break unp(5, k) = m + 1 'volume break
unp(7, k) = tbl(i, 7 + m) 'price unp(6, k) = tbl(i, 6 + m) 'price
unp(8, k) = i 'orig row unp(7, k) = i 'orig row
unp(9, k) = 7 + m 'orig col unp(8, k) = 6 + m 'orig col
Next m Next m
Next i Next i
unp(0, 0) = "stlc" unp(0, 0) = "stlc"
unp(1, 0) = "coltier" unp(1, 0) = "coltier"
unp(2, 0) = "branding" unp(2, 0) = "branding"
unp(3, 0) = "kit" unp(3, 0) = "accs"
unp(4, 0) = "suffix" 'unp(4, 0) = "suffix"
unp(5, 0) = "container" unp(4, 0) = "container"
unp(6, 0) = "volume" unp(5, 0) = "volume"
unp(7, 0) = "price" unp(6, 0) = "price"
unp(8, 0) = "orig_row" unp(7, 0) = "orig_row"
unp(9, 0) = "orig_col" unp(8, 0) = "orig_col"
If Not x.TBLp_TestNumeric(unp, 7) Then If Not x.TBLp_TestNumeric(unp, 7) Then
@ -1297,11 +1297,11 @@ Sub extract_price_matrix_r2()
'sql = x.SQLp_build_sql_values(unp, False, True, Db2, False) 'sql = x.SQLp_build_sql_values(unp, False, True, Db2, False)
sql = x.json_from_table(unv, "", False) sql = x.json_from_table(unv, "", False)
sql = "SELECT * FROM rlarp.build_pricelist_r1($$" & sql & "$$::jsonb)" sql = "SELECT * FROM rlarp.build_f20($$" & sql & "$$::jsonb)"
Call wapi.ClipBoard_SetData(sql) Call wapi.ClipBoard_SetData(sql)
'If MsgBox(sql, vbOKCancel, "continue with build?") = vbCancel Then Exit Sub '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
@ -1363,21 +1363,21 @@ Sub extract_price_matrix_r2()
j = 0 j = 0
For i = 1 To UBound(cms_pl, 1) For i = 1 To UBound(cms_pl, 1)
Select Case cms_pl(i, 15) Select Case cms_pl(i, 14)
Case "" Case ""
orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor = xlThemeColorAccent6 orig.Worksheet.Cells(orig.row + cms_pl(i, 12) - 1, orig.column + cms_pl(i, 13) - 1).Interior.ThemeColor = xlThemeColorAccent6
Case "no unit conversion" Case "no unit conversion"
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then If orig.Worksheet.Cells(orig.row + cms_pl(i, 12) - 1, orig.column + cms_pl(i, 13) - 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) orig.Worksheet.Cells(orig.row + cms_pl(i, 12) - 1, orig.column + cms_pl(i, 13) - 1).Interior.Color = RGB(255, 255, 161)
End If End If
Case "no part number" Case "no part number"
If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then If orig.Worksheet.Cells(orig.row + cms_pl(i, 12) - 1, orig.column + cms_pl(i, 13) - 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) orig.Worksheet.Cells(orig.row + cms_pl(i, 12) - 1, orig.column + cms_pl(i, 13) - 1).Interior.Color = RGB(255, 255, 161)
End If End If
End Select End Select
'if the current row/column is OK, advance to the next row/column 'if the current row/column is OK, advance to the next row/column
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) Do Until cms_pl(i, 12) <> cms_pl(i + j, 12) Or cms_pl(i, 13) <> cms_pl(i + j, 13)
j = j + 1 j = j + 1
If i + j >= UBound(cms_pl, 1) Then Exit Do If i + j >= UBound(cms_pl, 1) Then Exit Do
Loop Loop
@ -1403,7 +1403,7 @@ Sub extract_price_matrix_r2()
Selection.Columns(3).Interior.Pattern = xlNone Selection.Columns(3).Interior.Pattern = xlNone
Selection.Columns(4).Interior.Pattern = xlNone Selection.Columns(4).Interior.Pattern = xlNone
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