updates

FL.bas

@@ -1,4 +1,5 @@
 Attribute VB_Name = "FL"
+
 Option Explicit
 
 Public price_sheet As Worksheet
@@ -419,6 +420,7 @@ End Sub
 Sub PastValues()
 Attribute PastValues.VB_ProcData.VB_Invoke_Func = "V\n14"
 
+
 On Error GoTo errh
 
     Call Selection.PasteSpecial(xlPasteValues, xlNone, False, False)
@@ -431,6 +433,7 @@ End Sub
 Sub CollapsePvtItem()
 Attribute CollapsePvtItem.VB_ProcData.VB_Invoke_Func = "Z\n14"
 
+
 On Error GoTo show_det
     ActiveCell.PivotItem.DrilledDown = False
     
@@ -459,6 +462,7 @@ End Sub
 Sub ExpandPvtItem()
 Attribute ExpandPvtItem.VB_ProcData.VB_Invoke_Func = "X\n14"
 
+
 On Error GoTo show_det
     ActiveCell.PivotItem.DrilledDown = True
     
@@ -487,6 +491,7 @@ End Sub
 Sub CollapsePvtFld()
 Attribute CollapsePvtFld.VB_ProcData.VB_Invoke_Func = "A\n14"
 
+
 On Error GoTo show_det
     ActiveCell.PivotField.DrilledDown = False
     
@@ -516,6 +521,7 @@ End Sub
 Sub ExpandPvtFld()
 Attribute ExpandPvtFld.VB_ProcData.VB_Invoke_Func = "S\n14"
 
+
 On Error GoTo show_det
     ActiveCell.PivotField.DrilledDown = True
     
@@ -596,6 +602,10 @@ Sub SetPivotShortcutKeys()
     Call Application.MacroOptions("PERSONAL.xlsb!CollapsePvtItem", "", , , , "Z")
     Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtFld", "", , , , "S")
     Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtItem", "", , , , "X")
+    Call Application.MacroOptions("PERSONAL.xlsb!PastValues", "", , , , "V")
+    Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format", "", , , , "F")
+    Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_3dec", "", , , , "N")
+    Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_1dec", "", , , , "M")
 
 End Sub
 
@@ -703,6 +713,13 @@ Attribute pivot_field_format_3dec.VB_ProcData.VB_Invoke_Func = "N\n14"
 
 End Sub
 
+Sub pivot_field_format_1dec()
+Attribute pivot_field_format_1dec.VB_ProcData.VB_Invoke_Func = "M\n14"
+
+    ActiveSheet.PivotTables(1).PivotFields(ActiveCell.value).NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""???_);_(@_)"
+
+End Sub
+
 Sub Write_selection()
     Dim P As FileDialog
 
@@ -964,9 +981,9 @@ Sub extract_price_matrix()
         Select Case cms_pl(i, 13)
             Case ""
             Case "no unit conversion"
-                orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.Color = RGB(255, 255, 161)
+                orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
             Case "no part number"
-                'orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.Color = RGB(220, 220, 220)
+                'orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(220, 220, 220)
         End Select
     Next i
     
@@ -1147,14 +1164,14 @@ Sub extract_price_matrix_r1()
     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
+                orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 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
+                If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 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)
+                    orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 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
+                If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 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)
+                    orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
                 End If
         End Select
     Next i
@@ -1185,6 +1202,217 @@ 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) = 7 + 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")
+        new_sh.Name = "Price Build"
+    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
+    
+    '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
+    
+    j = 0
+    For i = 1 To UBound(cms_pl, 1)
+        Select Case cms_pl(i, 15)
+            Case ""
+                orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor = xlThemeColorAccent6
+            Case "no unit conversion"
+                If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
+                    orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
+                End If
+            Case "no part number"
+                If orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
+                    orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
+                End If
+        End Select
+        'if the current row/column is OK, advance to the next row/column
+        j = 0
+        Do Until cms_pl(i, 13) <> cms_pl(i + j, 13) Or cms_pl(i, 14) <> cms_pl(i + j, 14)
+            j = j + 1
+            If i + j >= UBound(cms_pl, 1) Then Exit Do
+        Loop
+        i = i + j - 1 '-1 becuase the "next i" will increment by 1 again
+    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.Columns(3).Interior.Pattern = xlNone
+    Selection.Columns(4).Interior.Pattern = xlNone
+    Selection.Columns(5).Interior.Pattern = xlNone
+    Selection.Columns(6).Interior.Pattern = xlNone
+    Selection.Rows(1).Interior.Pattern = xlNone
+
+    
+    '----------------------------cleanup-------------------------------------------------------------
+    
+    Set x = Nothing
+    
+End Sub
+
 Sub go_to_price_issue()
 
     Dim ws As Worksheet
@@ -1346,3 +1574,128 @@ PRICELIST_SHOW:
 
 End Sub
 
+
+
+Sub build_price_upload_r2()
+
+    Dim x As New TheBigOne
+    Dim pl() As String
+    Dim plv() As Variant
+    Dim i As Long
+    Dim j As Long
+    Dim ul() As String
+    Dim pl_code As String
+    Dim pl_action As String
+    Dim dtl_action As String
+    Dim pl_d1 As String
+    Dim pl_d2 As String
+    Dim pl_d3 As String
+    Dim fd As FileDialog
+    Dim ulsql As String
+    Dim temp() As String
+    Dim wapi As New Windows_API
+    
+    
+    pl = x.SHTp_GetString(Selection)
+    ReDim ul(11, UBound(pl, 2))
+    
+PRICELIST_SHOW:
+    
+    Call pricelist.load_lists
+    
+    pricelist.Show
+    
+    If Not pricelist.proceed Then Exit Sub
+    
+    pl_code = pricelist.cbLIST.value
+    pl_d1 = pricelist.tbD1.Text
+    pl_d2 = pricelist.tbD2.Text
+    pl_d3 = pricelist.tbD3.Text
+    pl_action = Mid(pricelist.cbHDR.value, 1, 1)
+    dtl_action = Mid(pricelist.cbDTL.value, 1, 1)
+    
+    
+    If Len(pricelist.cbLIST.value) > 5 Then
+        MsgBox ("price code must be 5 or less characters")
+        GoTo PRICELIST_SHOW
+    End If
+    
+    If Not pricelist.cbInactive Then
+        Call x.TBLp_FilterSingle(pl, 11, "I", False)
+    End If
+    
+    If Not pricelist.cbNonStocked Then
+        Call x.TBLp_FilterSingle(pl, 8, "A", True)
+    End If
+    
+    'need to get the current list of products and if they already exist for the target price list
+    'target price list
+    'target part
+    'target volume level
+    
+    
+    'ulsql = FL.x.SQLp_build_sql_values(pl, True, True, PostgreSQL, False)
+    'pl = x.TBLp_Transpose(pl)
+    'plv = x.TBLp_StringToVar(pl)
+    'ulsql = x.json_from_table(plv, "")
+    'ulsql = "DECLARE GLOBAL TEMPORARY TABLE session.plb AS (" & ulsql & ") WITH DATA"
+'    If login.tbP.Text = "" Then
+'        login.Show
+'        If Not login.proceed Then
+'            Exit Sub
+'        End If
+'    End If
+    'Call wapi.ClipBoard_SetData(ulsql)
+    'Exit Sub
+
+    'If Not FL.x.ADOp_Exec(0, ulsql, 1, True, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@041") Then
+    '    MsgBox (FL.x.ADOo_errstring)
+    '    Exit Sub
+    'End If
+    
+    'pl = FL.x.ADOp_SelectS(0, "SELECT p.*, CASE WHEN COALESCE(c.jcpart,'') = '' THEN '1' ELSE '2' END flag FROM Session.plb P LEFT OUTER JOIN lgdat.iprcc c ON c.jcpart = P.Item AND c.JCPLCD = '" & pl_code & "' AND c.JCVOLL = p.vbqty * cast(p.num as float) / cast(p.den as float)", True, 10000, True)
+    'If Not FL.x.ADOp_Exec(0, "DROP TABLE SESSION.PLB", 1, True, ISeries, "S7830956", False, login.tbU.Text, login.tbP.Text) Then
+    '    MsgBox (FL.x.ADOo_errstring)
+    '    Exit Sub
+    'End If
+    'Call FL.x.ADOp_CloseCon(0)
+    
+    
+    ul(0, 0) = "HDR"
+    ul(1, 0) = pl_action
+    ul(2, 0) = pl_code
+    ul(3, 0) = Left(pl_d1, 30)
+    ul(4, 0) = Left(pl_d2, 30)
+    ul(5, 0) = Left(pl_d3, 30)
+    ul(6, 0) = "Y"
+    ul(7, 0) = "N"
+    j = 0
+    For i = LBound(pl, 2) + 1 To UBound(pl, 2)
+        'if there is no [uom, part#, price], don't create a row
+        If pl(11, i) <> "" And pl(7, i) <> "" And pl(6, i) <> "" And pl(13, i) <> "" Then
+            j = j + 1
+            ul(0, j) = "DTL"                                                                'DTL
+            ul(1, j) = pl_code                                                              'Price list code
+            ul(2, j) = pl(6, i)                                                             'part number
+            ul(3, j) = pl(12, i)                                                            'price unit
+            ul(4, j) = Format(pl(11, i), "0.00000")                                            'volume break in price uom
+            ul(5, j) = Format(pl(13, i), "0.00000")                                            'price
+            ul(11, j) = dtl_action                                                          'add, update, delete
+        End If
+    Next i
+    
+    ReDim Preserve ul(11, j)
+
+    
+    '--------Open file-------------
+    
+    If Not x.FILEp_CreateCSV(pricelist.tbPATH.Text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then
+        MsgBox ("error")
+    End If
+    
+    'Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & Replace(pl_code, ".", "_") & ".csv")
+    
+    '---------------------header row---------------------------------
+    
+
+End Sub

TheBigOne.cls

@@ -7,7 +7,6 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = False
 Attribute VB_Exposed = False
-
 Option Explicit
 
 Private ADOo_con() As ADODB.Connection
@@ -1498,11 +1497,11 @@ End Function
 Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITLE As String = "") As Boolean
     
     Application.EnableCancelKey = xlDisabled
-    MsgB.tbMSG.text = Message
+    MsgB.tbMSG.Text = Message
     MsgB.Caption = TITLE
     MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
     MsgB.Show
-    MISC_msgbox_cancel = MsgB.Cancel
+    MISC_msgbox_cancel = MsgB.cancel
     Application.EnableCancelKey = xlInterrupt
 
 End Function
@@ -2138,20 +2137,20 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
     needs_braces = 0
     ajson = ""
     
-    For r = 2 To UBound(tbl, 1)
+    For r = LBound(tbl, 1) + 1 To UBound(tbl, 1)
-        For c = 1 To UBound(tbl, 2)
+        For c = LBound(tbl, 2) To UBound(tbl, 2)
             If tbl(r, c) <> "" Then
                 needs_braces = needs_braces + 1
                 If needs_comma Then json = json & ","
                 needs_comma = True
                 If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
-                    json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & tbl(r, c)
+                    json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & tbl(r, c)
                 Else
                     'test if item is a json object
                     If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
-                        json = json & """" & tbl(1, c) & """" & ":" & tbl(r, c)
+                        json = json & """" & tbl(LBound(tbl, 2), c) & """" & ":" & tbl(r, c)
                     Else
-                        json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
+                        json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
                     End If
                 End If
             End If
@@ -2159,7 +2158,7 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
         If needs_braces > 0 Then json = "{" & json & "}"
         needs_comma = False
         needs_braces = 0
-        If r > 2 Then
+        If r > LBound(tbl, 1) + 1 Then
             ajson = ajson & "," & json
         Else
             ajson = json
@@ -2170,7 +2169,7 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
     'if theres more the one record, include brackets for array
     'if an array_label is given give the array a key and the array become the value
     'then if the array is labeled with a key it should have braces unless specified otherwise
-    If r > 3 Then
+    If r > LBound(tbl, 1) + 2 Then
         ajson = "[" & ajson & "]"
         If array_label <> "" Then
             ajson = """" & array_label & """:" & ajson
@@ -2545,7 +2544,7 @@ Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As Strin
     Dim s As String, tmp As Double, i As Integer, lastI As Integer
     Dim BaseSize As Integer
     BaseSize = Len(sNewBaseDigits)
-    Do While val(d) <> 0
+    Do While Val(d) <> 0
         tmp = d
         i = 0
         Do While tmp >= BaseSize
@@ -2670,8 +2669,8 @@ Function TBLp_Transpose(ByRef t() As String) As String()
     
     ReDim x(LBound(t, 2) To UBound(t, 2), LBound(t, 1) To UBound(t, 1))
     
-    For i = 1 To UBound(t, 2)
+    For i = LBound(t, 2) To UBound(t, 2)
-        For j = 1 To UBound(t, 1)
+        For j = LBound(t, 1) To UBound(t, 1)
             x(i, j) = t(j, i)
         Next j
     Next i
@@ -2700,7 +2699,28 @@ Function TBLp_VarToString(ByRef t() As Variant) As String()
 
 End Function
 
-Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox, ParamArray cols())
+Function TBLp_StringToVar(ByRef t() As String) As Variant()
+
+    Dim i As Long
+    Dim j As Long
+    Dim x() As Variant
+    
+    If LBound(t, 1) = 1 Then
+    End If
+    
+    ReDim x(LBound(t, 1) To UBound(t, 1), LBound(t, 2) To UBound(t, 2))
+    
+    For i = LBound(t, 1) To UBound(t, 1)
+        For j = LBound(t, 2) To UBound(t, 2)
+            x(i, j) = t(i, j)
+        Next j
+    Next i
+
+    TBLp_StringToVar = x
+
+End Function
+
+Sub frmListBoxHeader(ByRef hdr As MSForms.ListBox, ByRef det As MSForms.ListBox, ParamArray cols())
 
     Dim i As Long
 
@@ -2728,3 +2748,4 @@ Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox,
     
 End Sub
 
+