FL.bas

@@ -1,5 +1,4 @@
 Attribute VB_Name = "FL"
-
 Option Explicit
 
 Public price_sheet As Worksheet
@@ -420,7 +419,6 @@ End Sub
 Sub PastValues()
 Attribute PastValues.VB_ProcData.VB_Invoke_Func = "V\n14"
 
-
 On Error GoTo errh
 
     Call Selection.PasteSpecial(xlPasteValues, xlNone, False, False)
@@ -433,7 +431,6 @@ End Sub
 Sub CollapsePvtItem()
 Attribute CollapsePvtItem.VB_ProcData.VB_Invoke_Func = "Z\n14"
 
-
 On Error GoTo show_det
     ActiveCell.PivotItem.DrilledDown = False
     
@@ -462,7 +459,6 @@ End Sub
 Sub ExpandPvtItem()
 Attribute ExpandPvtItem.VB_ProcData.VB_Invoke_Func = "X\n14"
 
-
 On Error GoTo show_det
     ActiveCell.PivotItem.DrilledDown = True
     
@@ -491,7 +487,6 @@ End Sub
 Sub CollapsePvtFld()
 Attribute CollapsePvtFld.VB_ProcData.VB_Invoke_Func = "A\n14"
 
-
 On Error GoTo show_det
     ActiveCell.PivotField.DrilledDown = False
     
@@ -521,7 +516,6 @@ End Sub
 Sub ExpandPvtFld()
 Attribute ExpandPvtFld.VB_ProcData.VB_Invoke_Func = "S\n14"
 
-
 On Error GoTo show_det
     ActiveCell.PivotField.DrilledDown = True
     
@@ -602,10 +596,6 @@ 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
 
@@ -713,13 +703,6 @@ 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
 
@@ -981,9 +964,9 @@ Sub extract_price_matrix()
         Select Case cms_pl(i, 13)
             Case ""
             Case "no unit conversion"
-                orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
+                orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.Color = RGB(255, 255, 161)
             Case "no part number"
-                'orig.Worksheet.Cells(orig.row + cms_pl(i, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(220, 220, 220)
+                'orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.Color = RGB(220, 220, 220)
         End Select
     Next i
     
@@ -1164,14 +1147,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, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor = xlThemeColorAccent6
+                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, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
+                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, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
+                    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, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.ThemeColor <> xlThemeColorAccent6 Then
+                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, 13) - 1, orig.column + cms_pl(i, 14) - 1).Interior.Color = RGB(255, 255, 161)
+                    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
@@ -1202,217 +1185,6 @@ 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
@@ -1574,128 +1346,3 @@ 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,6 +7,7 @@ Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = False
 Attribute VB_Exposed = False
+
 Option Explicit
 
 Private ADOo_con() As ADODB.Connection
@@ -1497,11 +1498,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
@@ -2137,20 +2138,20 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
     needs_braces = 0
     ajson = ""
     
-    For r = LBound(tbl, 1) + 1 To UBound(tbl, 1)
+    For r = 2 To UBound(tbl, 1)
-        For c = LBound(tbl, 2) To UBound(tbl, 2)
+        For c = 1 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(LBound(tbl, 2), c) & Chr(34) & ":" & tbl(r, c)
+                    json = json & Chr(34) & tbl(1, 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(LBound(tbl, 2), c) & """" & ":" & tbl(r, c)
+                        json = json & """" & tbl(1, c) & """" & ":" & tbl(r, c)
                     Else
-                        json = json & Chr(34) & tbl(LBound(tbl, 2), c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
+                        json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
                     End If
                 End If
             End If
@@ -2158,7 +2159,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 > LBound(tbl, 1) + 1 Then
+        If r > 2 Then
             ajson = ajson & "," & json
         Else
             ajson = json
@@ -2169,7 +2170,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 > LBound(tbl, 1) + 2 Then
+    If r > 3 Then
         ajson = "[" & ajson & "]"
         If array_label <> "" Then
             ajson = """" & array_label & """:" & ajson
@@ -2544,7 +2545,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
@@ -2669,8 +2670,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 = LBound(t, 2) To UBound(t, 2)
+    For i = 1 To UBound(t, 2)
-        For j = LBound(t, 1) To UBound(t, 1)
+        For j = 1 To UBound(t, 1)
             x(i, j) = t(j, i)
         Next j
     Next i
@@ -2699,28 +2700,7 @@ Function TBLp_VarToString(ByRef t() As Variant) As String()
 
 End Function
 
-Function TBLp_StringToVar(ByRef t() As String) As Variant()
+Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox, ParamArray cols())
-
-    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
 
@@ -2748,4 +2728,3 @@ Sub frmListBoxHeader(ByRef hdr As MSForms.ListBox, ByRef det As MSForms.ListBox,
     
 End Sub
 
-