work on core price list
This commit is contained in:
parent
4dc88d8faf
commit
b1c21d57ea
5
FL.bas
5
FL.bas
@ -1578,7 +1578,7 @@ Sub pricegroup_upload()
|
|||||||
If Not x.ADOp_Exec(0, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then
|
If Not x.ADOp_Exec(0, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then
|
||||||
MsgBox (x.ADOo_errstring)
|
MsgBox (x.ADOo_errstring)
|
||||||
Else
|
Else
|
||||||
MsgBox ("Upload Complete")
|
'MsgBox ("Upload Complete")
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Call x.ADOp_CloseCon(0)
|
Call x.ADOp_CloseCon(0)
|
||||||
@ -1587,6 +1587,7 @@ Sub pricegroup_upload()
|
|||||||
|
|
||||||
Call pricegroup_upload_db2
|
Call pricegroup_upload_db2
|
||||||
|
|
||||||
|
MsgBox ("Upload Complete")
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
@ -1637,7 +1638,7 @@ Sub pricegroup_upload_db2()
|
|||||||
If i + inc > UBound(ul, 2) Then inc = UBound(ul, 2) - i
|
If i + inc > UBound(ul, 2) Then inc = UBound(ul, 2) - i
|
||||||
Loop
|
Loop
|
||||||
|
|
||||||
MsgBox ("Upload Complete")
|
'MsgBox ("Upload Complete")
|
||||||
|
|
||||||
Call x.ADOp_CloseCon(0)
|
Call x.ADOp_CloseCon(0)
|
||||||
|
|
||||||
|
143
PriceLists.bas
143
PriceLists.bas
@ -1,7 +1,7 @@
|
|||||||
Attribute VB_Name = "PriceLists"
|
Attribute VB_Name = "PriceLists"
|
||||||
Option Explicit
|
Option Explicit
|
||||||
|
|
||||||
Sub extract_price_matrix_suff()
|
Sub test_full20()
|
||||||
|
|
||||||
'------------------------------------setup-------------------------------------------------
|
'------------------------------------setup-------------------------------------------------
|
||||||
|
|
||||||
@ -141,13 +141,41 @@ Sub extract_price_matrix_suff()
|
|||||||
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
|
||||||
If cell.Interior.ThemeColor = xlThemeColorAccent6 Then
|
If cell.Interior.ThemeColor = xlThemeColorAccent6 Then
|
||||||
|
'flag any cells that have prices that are not a formula
|
||||||
|
If IsNumeric(cell.value) And Mid(cell.Formula, 1, 1) <> "=" And cell.row > 3 And cell.column > 6 Then
|
||||||
|
'cell.Interior.Color = RGB(186, 85, 211)
|
||||||
|
' With cell.Borders(xlEdgeLeft)
|
||||||
|
' .LineStyle = xlContinuous
|
||||||
|
' .Color = -6279056
|
||||||
|
' .TintAndShade = 0
|
||||||
|
' .Weight = xlThick
|
||||||
|
' End With
|
||||||
|
' With cell.Borders(xlEdgeTop)
|
||||||
|
' .LineStyle = xlContinuous
|
||||||
|
' .Color = -6279056
|
||||||
|
' .TintAndShade = 0
|
||||||
|
' .Weight = xlThick
|
||||||
|
' End With
|
||||||
|
' With cell.Borders(xlEdgeRight)
|
||||||
|
' .LineStyle = xlContinuous
|
||||||
|
' .Color = -6279056
|
||||||
|
' .TintAndShade = 0
|
||||||
|
' .Weight = xlThick
|
||||||
|
' End With
|
||||||
|
' With cell.Borders(xlEdgeBottom)
|
||||||
|
' .LineStyle = xlContinuous
|
||||||
|
' .Color = -6279056
|
||||||
|
' .TintAndShade = 0
|
||||||
|
' .Weight = xlThick
|
||||||
|
' End With
|
||||||
|
End If
|
||||||
cell.Interior.Pattern = xlNone
|
cell.Interior.Pattern = xlNone
|
||||||
Else
|
Else
|
||||||
If cell.Interior.Pattern = xlNone And cell.value <> "" Then
|
If cell.Interior.Pattern = xlNone And cell.value <> "" Then
|
||||||
|
'---yellow-------
|
||||||
cell.Interior.Color = RGB(255, 255, 161)
|
cell.Interior.Color = RGB(255, 255, 161)
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
'if at this point the cell has no background, then there is no part, so highlight it, but only if a price is listed
|
|
||||||
Next cell
|
Next cell
|
||||||
|
|
||||||
Selection.Columns(1).Interior.Pattern = xlNone
|
Selection.Columns(1).Interior.Pattern = xlNone
|
||||||
@ -174,118 +202,51 @@ End Sub
|
|||||||
Sub price_load_plcore()
|
Sub price_load_plcore()
|
||||||
|
|
||||||
Dim x As New TheBigOne 'function library
|
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 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
|
Dim pcol() As Long 'hold the positions of each price list
|
||||||
ReDim pcol(30) 'size the array starting with 30 and trim later
|
Dim plist() As String
|
||||||
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 i As Long 'walks through each price list
|
||||||
Dim j As Long 'walks through each original row
|
Dim j As Long 'walks through each original row
|
||||||
Dim k As Long 'creates new rows for each price break
|
Dim k As Long 'creates new rows for each price break
|
||||||
Dim m As Long 'row position in the new table
|
Dim m As Long 'row position in the new table
|
||||||
Dim sql As String
|
Dim sql As String
|
||||||
|
|
||||||
|
'---current setup takes 2 minutes. need to break into smaller uploads, one price list per round--
|
||||||
|
|
||||||
'-------identify the active sheet and load the contents to an array-----------
|
'-------identify the active sheet and load the contents to an array-----------
|
||||||
|
|
||||||
Set sh = ActiveSheet
|
load = unpivot_current_sheet(plist, pcol)
|
||||||
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
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
'------if no columns are labeled plist then exit------------------------------
|
'------if no columns are labeled plist then exit------------------------------
|
||||||
|
|
||||||
If pcount = 0 Then Exit Sub
|
If UBound(pcol) = 0 Then Exit Sub
|
||||||
ReDim Preserve pcol(pcount)
|
|
||||||
ReDim typeflag(9)
|
|
||||||
|
|
||||||
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
|
'------clear out overlapping price lists--------------------------------------
|
||||||
MsgBox (Err.Description)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
'------prepare upload for each price list-------------------------------------
|
sql = ""
|
||||||
|
For i = 1 To UBound(plist)
|
||||||
typeflag(0) = "S"
|
If i > 1 Then
|
||||||
typeflag(1) = "S"
|
sql = sql & ",'" & plist(i) & "'"
|
||||||
typeflag(2) = "S"
|
|
||||||
typeflag(3) = "S"
|
|
||||||
typeflag(4) = "S"
|
|
||||||
typeflag(5) = "S"
|
|
||||||
typeflag(6) = "S"
|
|
||||||
typeflag(7) = "N"
|
|
||||||
typeflag(8) = "N"
|
|
||||||
typeflag(9) = "S"
|
|
||||||
|
|
||||||
For pcount = 1 To UBound(pcol)
|
|
||||||
'----since there are 3 price columns, those will need transformed to 3 price rows per each original-----
|
|
||||||
ReDim load(9, UBound(big, 2) * 3)
|
|
||||||
'----set headers-----
|
|
||||||
load(0, 0) = "stlc"
|
|
||||||
load(1, 0) = "coltier"
|
|
||||||
load(2, 0) = "branding"
|
|
||||||
load(3, 0) = "accs"
|
|
||||||
load(4, 0) = "suff"
|
|
||||||
load(5, 0) = "uomp"
|
|
||||||
load(6, 0) = "vol_uom"
|
|
||||||
load(7, 0) = "vol_qty"
|
|
||||||
load(8, 0) = "vol_price"
|
|
||||||
load(9, 0) = "listcode"
|
|
||||||
'-----populate------------
|
|
||||||
m = 1
|
|
||||||
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
|
Else
|
||||||
load(5, m) = big(5, i)
|
sql = sql & "'" & plist(i) & "'"
|
||||||
End If
|
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)
|
|
||||||
m = m + 1
|
|
||||||
Next k
|
|
||||||
Next i
|
Next i
|
||||||
'------build insert statement for target price list-----
|
sql = "DELETE FROM rlarp.plcore WHERE listcode in (" & sql & ");"
|
||||||
sql = "BEGIN;"
|
|
||||||
sql = sql & vbCrLf & "DELETE FROM rlarp.plcore WHERE listcode = '" & load(9, 1) & "';"
|
|
||||||
sql = sql & vbCrLf & "INSERT INTO rlarp.plcore"
|
sql = sql & vbCrLf & "INSERT INTO rlarp.plcore"
|
||||||
sql = sql & vbCrLf & x.SQLp_build_sql_values(load, True, True, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "S", "N", "N", "S") & ";"
|
sql = sql & vbCrLf & x.SQLp_build_sql_values(load, True, True, PostgreSQL, False, "S", "S", "S", "S", "S", "S", "S", "N", "N", "S", "N", "N") & ";"
|
||||||
sql = sql & vbCrLf & "COMMIT;"
|
|
||||||
'------do the insert------------------------------------
|
If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU, login.tbP, "Port=5030;Database=ubm") Then
|
||||||
If Not x.ADOp_Exec(0, sql) Then
|
MsgBox (x.ADOo_errstring)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Not x.ADOp_Exec(1, sql, 1, True, ADOinterface.SqlServer, "mid-sql02", True) Then
|
||||||
MsgBox (x.ADOo_errstring)
|
MsgBox (x.ADOo_errstring)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
Next pcount
|
|
||||||
|
|
||||||
Call x.ADOp_CloseCon(0)
|
Call x.ADOp_CloseCon(0)
|
||||||
|
Call x.ADOp_CloseCon(1)
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
@ -293,7 +254,7 @@ End Sub
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
Sub build_price_upload_suff()
|
Sub build_upload()
|
||||||
|
|
||||||
Dim x As New TheBigOne
|
Dim x As New TheBigOne
|
||||||
Dim pl() As String
|
Dim pl() As String
|
||||||
|
@ -72,6 +72,53 @@ Public Function TBLp_Aggregate(ByRef tbl() As String, ByRef needsort As Boolean,
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
Public Function TBLp_Group(ByRef tbl() As String, ByRef headers As Boolean, ParamArray cols()) As String()
|
||||||
|
|
||||||
|
On Error GoTo errh
|
||||||
|
Dim i As Long 'indexes primary row
|
||||||
|
Dim j As Long 'indexes secondary chaecker row
|
||||||
|
Dim k As Integer 'used to start at 0 or 1
|
||||||
|
Dim m As Long 'used to aggregate on sequencing lines (i and j aggregate to m line) then shorten array to m length - 1
|
||||||
|
|
||||||
|
k = 0
|
||||||
|
If headers Then k = 1
|
||||||
|
m = k
|
||||||
|
For i = k To UBound(tbl, 2)
|
||||||
|
If i = UBound(tbl, 2) Then
|
||||||
|
i = i
|
||||||
|
End If
|
||||||
|
j = i + 1
|
||||||
|
Do
|
||||||
|
If j > UBound(tbl, 2) Then Exit Do
|
||||||
|
If ROWe_MatchesFlag(tbl, i, j, gflds) Then
|
||||||
|
Call ROWp_Aggregate2Rows(tbl, i, j, sflds)
|
||||||
|
Else
|
||||||
|
Exit Do
|
||||||
|
End If
|
||||||
|
j = j + 1
|
||||||
|
If j > UBound(tbl, 2) Then
|
||||||
|
Exit Do
|
||||||
|
End If
|
||||||
|
Loop
|
||||||
|
Call ROWp_Copy(tbl, i, m)
|
||||||
|
m = m + 1
|
||||||
|
i = j - 1
|
||||||
|
Next i
|
||||||
|
|
||||||
|
ReDim Preserve tbl(UBound(tbl, 1), m - 1)
|
||||||
|
|
||||||
|
errh:
|
||||||
|
If Err.Number <> 0 Then
|
||||||
|
Me.ADOo_errstring = Err.Description
|
||||||
|
TBLp_Roll = False
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
TBLp_Roll = True
|
||||||
|
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
Function TBLp_BubbleSortAsc(ByRef tbl() As String, ByRef sortflds() As Integer, ByRef typeflds() As String, ByRef headers As Boolean) As Boolean
|
Function TBLp_BubbleSortAsc(ByRef tbl() As String, ByRef sortflds() As Integer, ByRef typeflds() As String, ByRef headers As Boolean) As Boolean
|
||||||
|
|
||||||
@ -1843,7 +1890,7 @@ Public Function ADOp_Exec(ByRef con As Integer, ByVal sql As String, Optional Ap
|
|||||||
GoTo conerr
|
GoTo conerr
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
|
ADOo_con(con).CommandTimeout = 600
|
||||||
Call ADOo_con(con).Execute(sql)
|
Call ADOo_con(con).Execute(sql)
|
||||||
ADOp_Exec = True
|
ADOp_Exec = True
|
||||||
Exit Function
|
Exit Function
|
||||||
|
Loading…
Reference in New Issue
Block a user