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

rework logic to hook off of color indicator supplied instead of using first 11

Browse Source
This commit is contained in:
Paul Trowbridge 2020-01-15 11:41:19 -05:00
parent 79e3c24a37
commit b4291d15e7
1 changed files with 54 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
FL.bas
View File

@ -2,8 +2,21 @@ Attribute VB_Name = "FL"
Option Explicit
Public price_sheet As Worksheet
Public x As New TheBigOne
Public Enum ColorTier
B_ase = 0
T_raditional = 1
principa_L = 2
pre_M_ium = 3
P_rogram = 4
C_ustom = 5
E_cogrow = 6
O_rganic = 7
W_axtough = 8
End Enum
Sub Determine_Active_Range()
@ -770,37 +783,39 @@ Sub extract_price_matrix()
Dim j As Long
Dim k As Long
k = 0
ReDim unp(7, (UBound(tbl, 2) - 1) * (UBound(tbl, 1) - 3))
For i = 4 To UBound(tbl, 1)
ReDim unp(8, (UBound(tbl, 2) - 1) * (UBound(tbl, 1) - 4))
For i = 5 To UBound(tbl, 1)
For j = 2 To UBound(tbl, 2)
k = k + 1
'part
unp(0, k) = tbl(i, 1)
'copy headers down the left
unp(1, k) = tbl(1, j) 'size code (row one, column j)
unp(2, k) = tbl(2, j) 'volue break uom (row 2, column j)
unp(3, k) = Format(tbl(3, j), "#.00") 'volue break qty (row 3, column j)
unp(4, k) = "M" 'pricing unit of measuer
unp(5, k) = Format(tbl(i, j), "#.00") 'price (row i, column j)
unp(6, k) = i
unp(7, k) = j
unp(1, k) = tbl(1, j) 'color code/tier (row one, column j)
unp(2, k) = tbl(2, j) 'size code (row two, column j)
unp(3, k) = tbl(3, j) 'volue break uom (row 3, column j)
unp(4, k) = Format(tbl(4, j), "#.00") 'volue break qty (row 4, column j)
unp(5, k) = "M" 'pricing unit of measuer
unp(6, k) = Format(tbl(i, j), "#.00") 'price (row i, column j)
unp(7, k) = i
unp(8, k) = j
Next j
Next i
unp(0, 0) = "mold"
unp(1, 0) = "sizc"
unp(2, 0) = "vbuom"
unp(3, 0) = "vbqty"
unp(4, 0) = "puom"
unp(5, 0) = "price"
unp(6, 0) = "orig_row"
unp(7, 0) = "orig_col"
unp(2, 0) = "color"
unp(3, 0) = "vbuom"
unp(4, 0) = "vbqty"
unp(5, 0) = "puom"
unp(6, 0) = "price"
unp(7, 0) = "orig_row"
unp(8, 0) = "orig_col"
If Not x.TBLp_TestNumeric(unp, 3) Then
If Not x.TBLp_TestNumeric(unp, 4) Then
MsgBox ("volume break quantity is text")
Exit Sub
End If
If Not x.TBLp_TestNumeric(unp, 5) Then
If Not x.TBLp_TestNumeric(unp, 6) Then
MsgBox ("price is text")
Exit Sub
End If
@ -880,12 +895,12 @@ Sub extract_price_matrix()
End With
For i = 1 To UBound(cms_pl, 1)
Select Case cms_pl(i, 9)
Select Case cms_pl(i, 11)
Case ""
Case "no unit conversion"
orig.Worksheet.Cells(orig.row + cms_pl(i, 10) - 1, orig.column + cms_pl(i, 11) - 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)
Case "no part number"
orig.Worksheet.Cells(orig.row + cms_pl(i, 10) - 1, orig.column + cms_pl(i, 11) - 1).Interior.Color = RGB(220, 220, 220)
orig.Worksheet.Cells(orig.row + cms_pl(i, 12) - 1, orig.column + cms_pl(i, 13) - 1).Interior.Color = RGB(220, 220, 220)
End Select
Next i
@ -920,11 +935,13 @@ Sub go_to_price_issue()
trow = orig.row - Selection.row + 1
tcol = orig.column - Selection.column + 1
orig.Select
i = 1
Do Until price_sheet.Cells(i, 1) = ""
If price_sheet.Cells(i, 11) = trow And price_sheet.Cells(i, 12) = tcol Then
If price_sheet.Cells(i, 13) = trow And price_sheet.Cells(i, 14) = tcol And price_sheet.Cells(i, 12) <> "" Then
price_sheet.Select
ActiveSheet.Cells(i, 10).Select
ActiveSheet.Cells(i, 12).Select
Exit Sub
End If
i = i + 1
@ -974,18 +991,23 @@ PRICELIST_SHOW:
ul(5, 0) = Left(pl_d3, 30)
ul(6, 0) = "Y"
ul(7, 0) = "N"
j = 1
j = 0
For i = LBound(pl, 2) + 1 To UBound(pl, 2)
'if there is no UOM conversion, don't create a row
If pl(10, i) <> "" And pl(11, i) <> "" Then
j = j + 1
ul(0, j) = "DTL"
ul(1, j) = pl_code
ul(2, j) = pl(7, i)
ul(3, j) = pl(5, i)
ul(4, j) = Format(CDbl(pl(4, i)) * CDbl(pl(8, i)) / CDbl(pl(9, i)), "0.00")
ul(2, j) = pl(9, i)
ul(3, j) = pl(7, i)
ul(4, j) = Format(CDbl(pl(6, i)) * CDbl(pl(10, i)) / CDbl(pl(11, i)), "0.00")
ul(5, j) = Format(pl(6, i), "0.00")
ul(11, j) = "1"
j = j + 1
End If
Next i
ReDim Preserve ul(11, j)
'--------Open file-------------