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

updates to nursery regional parsing

Browse Source
This commit is contained in:
Paul Trowbridge 2021-08-13 10:34:20 -04:00
parent c80e5296d1
commit 34984de260
1 changed files with 32 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
FL.bas
View File

@ -1572,6 +1572,7 @@ Sub nursery_parse()
Dim m() As String 'customer name Dim m() As String 'customer name
Dim ext() As String Dim ext() As String
Dim sql As String Dim sql As String
Dim exists As Boolean
z = 0 z = 0
partcol = 2 partcol = 2
@ -1594,14 +1595,14 @@ Sub nursery_parse()
i = i - 1 i = i - 1
'----find starting column---------------------------- '----find starting column----------------------------
j = 1 j = 1
Do Until sh.Cells(a, j) = "Order $" Or j = 1000 Do Until InStr(sh.Cells(a, j), "Order $") Or j = 1000
j = j + 1 j = j + 1
Loop Loop
c = 1 c = 1
'----identity price columns numbers------------------ '----identity price columns numbers------------------
n = 0 n = 0
Do Until sh.Cells(a, c + j) = "" Do Until sh.Cells(a, c + j) = ""
If sh.Cells(a, c + j) = "NEW PRICE" Then If InStr(sh.Cells(a, c + j), "NEW PRICE") > 0 Then
n = n + 1 n = n + 1
p(n) = c + j p(n) = c + j
End If End If
@ -1621,7 +1622,6 @@ Sub nursery_parse()
ReDim Preserve p(n) ReDim Preserve p(n)
ReDim Preserve m(n) ReDim Preserve m(n)
'---for each customer loop through all the parts '---for each customer loop through all the parts
For n = 1 To UBound(p) For n = 1 To UBound(p)
For b = a + 1 To i For b = a + 1 To i
@ -1636,13 +1636,31 @@ Sub nursery_parse()
'not a price tab 'not a price tab
End If End If
Next sh Next sh
ReDim Preserve ext(3, z) ReDim Preserve ext(3, z)
Call tbo.TBLp_FilterSingle(ext, 2, "0", False) Call tbo.TBLp_FilterSingle(ext, 2, "0", False)
Call tbo.TBLp_FilterSingle(ext, 2, "", False) Call tbo.TBLp_FilterSingle(ext, 2, "", False)
'---------dump consolidated pricing to worksheet------------
exists = False
For Each sh In Application.Worksheets
If sh.Name = "consolidated price list" Then
sh.Cells.ClearContents
exists = True
Exit For
End If
Next sh
'---------
If Not exists Then
Set sh = Application.Worksheets.Add()
sh.Name = "consolidated price list"
End If
Call tbo.SHTp_Dump(ext, "consolidated price list", 1, 1, False, True)
ext = tbo.TBLp_Transpose(ext)
sql = tbo.ADOp_BuildInsertSQL(ext, "rlarp.nregional", True, 1, UBound(ext, 2), Array("S", "S", "N", "S")) sql = tbo.ADOp_BuildInsertSQL(ext, "rlarp.nregional", True, 1, UBound(ext, 2), Array("S", "S", "N", "S"))
sql = "truncate table rlarp.nregional;" & vbCrLf & sql & ";" sql = "truncate table rlarp.nregional;" & vbCrLf & sql & ";"
If Not tbo.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then If Not tbo.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
@ -1651,4 +1669,14 @@ Sub nursery_parse()
MsgBox ("Uploaded") MsgBox ("Uploaded")
End If End If
End Sub
Sub convert_to_value()
For Each c In Selection.Cells
If IsNumeric(c.value) Then c.value = CDbl(c.value)
Next c
End Sub End Sub