Alguém sabe me dizer o pq não estou conseguindo dar espaço no textbox1 do formulário?

Código abaixo

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim linha As Long
linha = ActiveCell.Row

'colocando o valor selecionado com duplo clique
'na célula ativa
Planilha1.Cells(linha, 1).Value = Me.ListBox1.Value
Unload Me
End Sub

Private Sub UserForm_Initialize()
'  ListBox1.ColumnCount = 1
 ' ListBox1.ColumnWidths = "20"
End Sub
Private Sub TextBox1_Change()
    'Nome da planilha em que estão os registros:
  Const csPlan As String = "Alimentos"
  
  'Em qual coluna estão os registros?
  Const csCol As String = "B"
  
  Dim col As VBA.Collection
  Dim lLast As Long
  Dim lRow As Long
  Dim vKey As Variant
  Dim ws As Excel.Worksheet
  Dim l As Long
  Dim lCount As Long
  
  Do While InStr(TextBox1, "  ")
    TextBox1 = Replace(TextBox1, "  ", " ")
  Loop
  TextBox1 = Trim(TextBox1)
  
    
  Set col = New VBA.Collection
  ListBox1.Clear
  Set ws = ThisWorkbook.Worksheets(csPlan)
  With ws
    lLast = .Cells(.Rows.Count, csCol).End(xlUp).Row
    'Considerando uma linha de cabeçalho:
    For lRow = 3 To lLast
      For Each vKey In Split(TextBox1, " ")
        If UCase(.Cells(lRow, csCol)) Like "*" & UCase(vKey) & "*" Then
          On Error Resume Next
          col.Add CStr(lRow), CStr(lRow)
          On Error GoTo 0
        End If
      Next vKey
    Next lRow
  End With

  With ListBox1
    For l = 1 To col.Count
      .AddItem (ws.Cells(col(l), csCol))
    '  lCount = .ListCount - 1
     ' .List(lCount, 1) = col(1)
    '  .List(lCount, 1) = ws.Cells(col(l), csCol)
    Next l
  End With
End Sub

Anexo do Formulário, só clicar nas células A