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 ext() As String
Dim sql As String
Dim exists As Boolean
z = 0
partcol = 2
@ -1594,14 +1595,14 @@ Sub nursery_parse()
i = i - 1
'----find starting column----------------------------
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
Loop
c = 1
'----identity price columns numbers------------------
n = 0
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
p(n) = c + j
End If
@ -1621,7 +1622,6 @@ Sub nursery_parse()
ReDim Preserve p(n)
ReDim Preserve m(n)
'---for each customer loop through all the parts
For n = 1 To UBound(p)
For b = a + 1 To i
@ -1636,13 +1636,31 @@ Sub nursery_parse()
'not a price tab
End If
Next sh
ReDim Preserve ext(3, z)
Call tbo.TBLp_FilterSingle(ext, 2, "0", 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 = "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
@ -1651,4 +1669,14 @@ Sub nursery_parse()
MsgBox ("Uploaded")
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