XL 2010 searchable listbox

Dim TblBD(), NbCol
Option Compare Text
Private Sub UserForm_Initialize()
  Dim f, Rng
  Set f = Sheets("suivis_facture")
  Set Rng = f.Range("A4:K" & f.[A650000].End(xlUp).Row)
  TblBD = Rng.Value
  NbCol = UBound(TblBD, 2)
  Me.ListBox1.List = TblBD
  Me.ListBox1.ColumnCount = NbCol
  Me.ListBox1.ColumnWidths = "30;60;80;60;50;60;60;60;50;50;50"
End Sub

Private Sub TextBox1_Change()
  Dim colRecherche, clé, i, n, k
  colRecherche = 3
  clé = "*" & Me.TextBox1 & "*"
  Dim Tbl()
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.List = TblBD
End Sub

Dim Rng, TblBD(), NbCol
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set Rng = f.Range("A2:K" & f.[A650000].End(xlUp).Row)
  TblBD = Rng.Value
  For i = 1 To UBound(TblBD):
    TotalFact = TotalFact + TblBD(i, 4)
    TotalCrédit = TotalCrédit + TblBD(i, 10)
    TblBD(i, 4) = Format(TblBD(i, 4), "0000.00")
  Next i
  NbCol = UBound(TblBD, 2)
  Me.ListBox1.List = TblBD
  Me.TextBox2 = Format(TotalFact, "0000.00")
  Me.TextBox3 = Format(TotalCrédit, "0000.00")
  Me.ListBox1.ColumnCount = NbCol
  'Me.ListBox1.ColumnWidths = "30;60;90;60"
  EnteteListBox
End Sub

Private Sub TextBox1_Change()
  colRecherche = 3
  clé = "*" & Me.TextBox1 & "*"
  Dim Tbl()
  TotalFact = 0
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Then
        n = n + 1
        ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
        TotalFact = TotalFact + TblBD(i, 4)
        TotalCrédit = TotalCrédit + TblBD(i, 10)
     End If
  Next i
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     Me.TextBox2 = Format(TotalFact, "0000.00")
     Me.TextBox3 = Format(TotalCrédit, "0000.00")
   Else
     Me.ListBox1.List = TblBD
     Me.TextBox2 = Format(Application.Sum(Application.Index(TblBD, , 4)), "0000.00")
     Me.TextBox3 = Format(Application.Sum(Application.Index(TblBD, , 10)), "0000.00")
   End If
End Sub

Sub EnteteListBox()
  x = Me.ListBox1.Left + 8
  Y = Me.ListBox1.Top - 12
  For i = 1 To NbCol
    Set lab = Me.Controls.Add("Forms.Label.1")
    lab.Caption = Rng.Offset(-1).Cells(1, i)
    lab.Top = Y
    lab.Left = x
    x = x + Rng.Columns(i).Width * 1.1
    temp = temp & Rng.Columns(i).Width * 1.1 & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnWidths = temp
End Sub

Option Compare Text
Dim f, RngBD, ColRecherche
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set d = CreateObject("Scripting.Dictionary")
  Set RngBD = f.[A1].CurrentRegion.Offset(1)
  ColRecherche = 3
  d("*") = ""
  For i = 1 To RngBD.Rows.Count
     clé = RngBD.Cells(i, ColRecherche): d(clé) = ""
  Next i
  Me.ComboBox1.List = d.keys                        ' liste des professions sans doublons
  Me.ListBox1.ColumnCount = RngBD.Columns.Count
  Me.ListBox1.ColumnWidths = "20;50;90;60;50;50;50;50;50;50;50"    ' à adapter
  Me.ListBox1.ColumnHeads = True
  ComboBox1_click
End Sub

Private Sub ComboBox1_click()
  Set f2 = Sheets("filtre")
  f2.Cells.Clear
  f2.[Z1] = RngBD.Offset(-1).Cells(1, ColRecherche): f2.[Z2] = Me.ComboBox1
  f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f2.[Z1:Z2], _
      CopyToRange:=f2.[A1], Unique:=False
  Set RngFiltre = f2.[A1].CurrentRegion.Offset(1).Resize(f2.[A1].CurrentRegion.Rows.Count - 1)
  Me.ListBox1.RowSource = RngFiltre.Address(External:=True)
  Me.TextBox2 = Format(Application.Sum(Application.Index(RngFiltre, , 4)), "0000.00")
  Me.TextBox3 = Format(Application.Sum(Application.Index(RngFiltre, , 10)), "0000.00")
End Sub