add another iteration of the price list logic

FL.bas

@@ -1185,6 +1185,207 @@ Sub extract_price_matrix_r1()
     
 End Sub
 
+Sub extract_price_matrix_r2()
+
+    '------------------------------------setup-------------------------------------------------
+
+    Dim wapi As New Windows_API
+    Dim x As New TheBigOne
+    Dim tbl() As Variant
+    Dim unp() As String
+    Dim unv() As Variant
+    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) < 2 Then error = "selection is not a valid price matrix"
+    If UBound(tbl, 2) < 9 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
+    Dim m As Long
+    k = 0
+    ReDim unp(9, (UBound(tbl, 1) - 1) * 3)
+    'iterate through rows
+    For i = 2 To UBound(tbl, 1)
+        '3 iterations per row
+        For m = 0 To 2
+            k = k + 1
+            'part
+            unp(0, k) = tbl(i, 1)                   'stlye code
+            unp(1, k) = tbl(i, 2)                   'color tier
+            unp(2, k) = tbl(i, 3)                   'branding
+            unp(3, k) = tbl(i, 4)                   'kit
+            unp(4, k) = tbl(i, 5)                   'suffix
+            unp(5, k) = tbl(i, 6)                   'container
+            unp(6, k) = m + 1                       'volume break
+            unp(7, k) = tbl(i, 7 + m)               'price
+            unp(8, k) = i                           'orig row
+            unp(9, k) = j + m                       'orig col
+        Next m
+    Next i
+    unp(0, 0) = "stlc"
+    unp(1, 0) = "coltier"
+    unp(2, 0) = "branding"
+    unp(3, 0) = "kit"
+    unp(4, 0) = "suffix"
+    unp(5, 0) = "container"
+    unp(6, 0) = "volume"
+    unp(7, 0) = "price"
+    unp(8, 0) = "orig_row"
+    unp(9, 0) = "orig_col"
+    
+    
+    If Not x.TBLp_TestNumeric(unp, 7) Then
+        MsgBox ("price is text")
+        Exit Sub
+    End If
+    
+    unp = x.TBLp_Transpose(unp)
+    unv = x.TBLp_StringToVar(unp)
+    
+    '-------------------------prepare sql to upload---------------------------------------------------------------
+    
+    'sql = x.SQLp_build_sql_values(unp, False, True, Db2, False)
+    sql = x.json_from_table(unv, "", False)
+    sql = "SELECT * FROM rlarp.build_pricelist_r1($$" & sql & "$$::jsonb)"
+    Call wapi.ClipBoard_SetData(sql)
+    
+    If MsgBox(sql, vbOKCancel, "continue with build?") = vbCancel Then Exit Sub
+    
+    login.Show
+    If Not login.proceed Then Exit Sub
+    
+    
+    If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, login.tbU.Text, login.tbP.Text, "Port=5030;Database=ubm") Then
+        MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring)
+        Exit Sub
+    End If
+    
+    cms_pl = x.ADOp_SelectS(0, sql, True, 50000, True)
+    
+    Call x.ADOp_CloseCon(0)
+    
+    '--------------------------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
+                Exit For
+            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
+    
+    Exit Sub
+    With orig.Interior
+        .Pattern = xlNone
+        .TintAndShade = 0
+        .PatternTintAndShade = 0
+    End With
+    
+    'if a cell has even one valid hit, don't show an error
+    'create a copy of tbl
+    'the default value for cell is error, if any good values are found, they stay
+    
+    
+    For i = 1 To UBound(cms_pl, 1)
+        Select Case cms_pl(i, 13)
+            Case ""
+                orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.ThemeColor = xlThemeColorAccent6
+            Case "no unit conversion"
+                If orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
+                    orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.Color = RGB(255, 255, 161)
+                End If
+            Case "no part number"
+                If orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
+                    orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.Color = RGB(255, 255, 161)
+                End If
+        End Select
+    Next i
+    
+    Dim cell As Range
+    
+    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 cell.Interior.ThemeColor = xlThemeColorAccent6 Then
+            cell.Interior.Pattern = xlNone
+        Else
+            If cell.Interior.Pattern = xlNone And cell.value <> "" Then
+                cell.Interior.Color = RGB(255, 255, 161)
+            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
+    
+    Selection.Columns(1).Interior.Pattern = xlNone
+    Selection.Columns(2).Interior.Pattern = xlNone
+    Selection.Rows(1).Interior.Pattern = xlNone
+    Selection.Rows(2).Interior.Pattern = xlNone
+    Selection.Rows(3).Interior.Pattern = xlNone
+    
+    '----------------------------cleanup-------------------------------------------------------------
+    
+    Set x = Nothing
+    
+End Sub
+
 Sub go_to_price_issue()
 
     Dim ws As Worksheet