build price list functionality

FL.bas

@@ -1,5 +1,6 @@
 Option Explicit
 
+Public price_sheet As Worksheet
 
 Public x As New TheBigOne
 
@@ -253,6 +254,7 @@ Function json_from_list(keys As range, values As range) As String
     Dim i As Integer
     Dim first_comma As Boolean
     Dim needs_braces As Integer
+    Dim needs_comma As Boolean
     
     needs_comma = False
     needs_braces = 0
@@ -276,6 +278,12 @@ Function json_from_list(keys As range, values As range) As String
 
 End Function
 
+Function json_nest(key As String, json As String) As String
+
+       json_nest = "{""" & key & """:" & json & "}"
+
+End Function
+
 Function json_concat(list As range) As String
     
         Dim json As String
@@ -306,6 +314,7 @@ Sub json_from_table_pretty()
     Dim x As New TheBigOne
     Dim tbl() As Variant
     
+    Selection.CurrentRegion.Select
     tbl = Selection
     
     Dim ajson As String
@@ -357,6 +366,7 @@ Sub json_from_table()
     
     Dim tbl() As Variant
     
+    Selection.CurrentRegion.Select
     tbl = Selection
          
     Call wapi.ClipBoard_SetData(x.json_from_table(tbl, "y", False))
@@ -555,6 +565,7 @@ Sub markdown_from_table()
     Dim wapi As New Windows_API
     Dim tbl() As Variant
    
+    Selection.CurrentRegion.Select
     tbl = Selection
       
     Call wapi.ClipBoard_SetData(x.markdown_from_table(tbl))
@@ -589,7 +600,7 @@ Sub sql_from_range()
     Dim x As New TheBigOne
     Dim wapi As New Windows_API
     Dim r() As String
-    
+    Selection.CurrentRegion.Select
     Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2))
 
 End Sub
@@ -672,4 +683,233 @@ Sub split_forecast_data()
         
     
     
+End Sub
+
+Function range_empty(ByRef r As range) As Boolean
+
+    Dim c As range
+    range_empty = True
+    
+    For Each c In r.Cells
+        If Not IsEmpty(c.value) Then
+            range_empty = False
+            Exit Function
+        End If
+    Next c
+        
+End Function
+
+Function build_monthly(ByRef part As String, billto_group As String, month As String, vol As Double, amt As Double) As String
+
+    Dim j As Object
+    
+    Set j("part") = part
+    Set j("billto_group") = billto_group
+    Set j("month") = month
+    Set j("part") = vol
+    Set j("part") = amt
+    
+    build_monthly = JsonConverter.ConvertToJson(j)
+
+End Function
+
+Sub extract_price_matrix()
+
+    '------------------------------------setup-------------------------------------------------
+
+    Dim wapi As New Windows_API
+    Dim x As New TheBigOne
+    Dim tbl() As Variant
+    Dim unp() As String
+    Dim unps() As String
+    Dim sql As String
+    Dim error As String
+    Dim orig As range
+    Dim cms_pl() As String
+    Dim pw As String
+    Dim new_sh As Worksheet
+    Dim ws As Worksheet
+    Dim cp As CustomProperty
+    
+    '------------------------------------selection-------------------------------------------------
+    
+    Set orig = Application.Selection
+    
+    Selection.CurrentRegion.Select
+    
+    Set orig = Application.Selection
+    
+    '--------------------------------test if valid price matrix------------------------------
+    
+    If Selection.Cells.Count = 1 Then
+        MsgBox ("selection is not a table")
+        orig.Select
+        Exit Sub
+    End If
+    
+    tbl = Selection
+    
+    If UBound(tbl, 1) < 4 Then error = "selection is not a valid price matrix"
+    If UBound(tbl, 2) < 2 Then error = "selection is not a valid price matrix"
+    If Not error = "" Then
+        MsgBox (error)
+        Exit Sub
+    End If
+        
+    '-----------------------------unpivot price matrix into new array-----------------------------
+         
+    Dim i As Long
+    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)
+        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
+        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"
+    
+    
+    '-------------------------prepare sql to upload---------------------------------------------------------------
+    
+    sql = x.SQLp_build_sql_values(unp, False, True, Db2)
+    sql = "DECLARE GLOBAL TEMPORARY TABLE session.plbuild AS (" & sql & ") WITH DATA"
+    Call wapi.ClipBoard_SetData(sql)
+    
+    login.Show
+    If Not login.proceed Then Exit Sub
+    
+    
+    If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, login.tbU.Text, login.tbP.Text) Then
+        MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring)
+        Exit Sub
+    End If
+    
+    If Not x.ADOp_Exec(0, sql) Then
+        MsgBox (x.ADOo_errstring)
+        Call x.ADOp_CloseCon(0)
+        Exit Sub
+    End If
+    
+    '-------------------call price build procedure--------------------------------------------------------
+    
+    cms_pl = x.ADOp_SelectS(0, "CALL rlarp.build_pricelist", True, 25000, True)
+    
+    Call x.ADOp_CloseCon(0)
+    
+    If x.ADOo_errstring <> "" Then
+        MsgBox (x.ADOo_errstring)
+        Exit Sub
+    End If
+    
+    '--------------------------setup an output sheet if necessary-------------------------------
+    
+    For Each ws In Application.Worksheets
+        For Each cp In ws.CustomProperties
+            If cp.Name = "spec_name" And cp.value = "price_list" Then
+                Set new_sh = ws
+            End If
+        Next cp
+    Next ws
+    
+    If new_sh Is Nothing Then
+        Set new_sh = Application.Worksheets.Add
+        Call new_sh.CustomProperties.Add("spec_name", "price_list")
+    End If
+    
+    '-------------------------dump contents------------------------------------------------------
+    
+    Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
+    new_sh.Select
+    ActiveSheet.Cells(1, 1).CurrentRegion.Select
+    Selection.Columns.AutoFit
+    
+    Rows("1:1").Select
+    With ActiveWindow
+        .SplitColumn = 0
+        .SplitRow = 1
+    End With
+    ActiveWindow.FreezePanes = True
+    
+    
+    '--------------------------format source cells for any build issues--------------------------------
+    
+    orig.Worksheet.Select
+
+    With orig.Interior
+        .Pattern = xlNone
+        .TintAndShade = 0
+        .PatternTintAndShade = 0
+    End With
+    
+    For i = 1 To UBound(cms_pl, 1)
+        Select Case cms_pl(i, 9)
+            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)
+            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)
+        End Select
+    Next i
+    
+    '----------------------------cleanup-------------------------------------------------------------
+    
+    Set x = Nothing
+    
+End Sub
+
+Sub go_to_price_issue()
+
+    Dim ws As Worksheet
+    Dim cp As CustomProperty
+    Dim orig As range
+    Dim trow As Long
+    Dim tcol As Long
+    Dim i As Long
+    
+    For Each ws In Application.Worksheets
+        For Each cp In ws.CustomProperties
+            If cp.Name = "spec_name" And cp.value = "price_list" Then
+                Set price_sheet = ws
+            End If
+        Next cp
+    Next ws
+    
+    Set orig = Application.Selection
+    
+    Selection.CurrentRegion.Select
+
+    
+    trow = orig.row - Selection.row + 1
+    tcol = orig.column - Selection.column + 1
+    
+    i = 1
+    Do Until price_sheet.Cells(i, 1) = ""
+        If price_sheet.Cells(i, 11) = trow And price_sheet.Cells(i, 12) = tcol Then
+            price_sheet.Select
+            ActiveSheet.Cells(i, 10).Select
+            Exit Sub
+        End If
+        i = i + 1
+    Loop
+    
+
 End Sub