updates to nursery regional parsing
This commit is contained in:
		
							parent
							
								
									c80e5296d1
								
							
						
					
					
						commit
						34984de260
					
				
							
								
								
									
										36
									
								
								FL.bas
									
									
									
									
									
								
							
							
						
						
									
										36
									
								
								FL.bas
									
									
									
									
									
								
							| @ -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 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user