Pessoal estou com problema no seguinte código. Quando eu digito algo no textbox que atualiza a listbox ele dá pau no código.

Segue código pra ilustrar:

Option Explicit
Private TextoDigitado As String


Private Sub ListBox1_Click()
    ActiveCell.Value = ListBox1.Value
    ActiveCell.Offset(1, 0).Activate
    
End Sub

Private Sub ListBox2_Click()
    ActiveCell.Value = ListBox2.Value
    ActiveCell.Offset(1, 0).Activate
End Sub

Private Sub TextBox1_Change()
    TextoDigitado = TextBox1.Text
    Call PreencheLista
    
End Sub
Private Sub UserForm_Initialize()
    Call PreencheLista
End Sub
Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim i, k As Integer
    Dim TextoCelula1, TextoCelula2 As String
    Set ws = ThisWorkbook.Worksheets(3)
    i = 7
    k = 0
    ListBox1.Clear
    With ws
        While .Cells(i, 3).Value <> Empty
            TextoCelula1 = .Cells(i, 3).Value
            TextoCelula2 = .Cells(i, 2).Value
            If UCase(Left(TextoCelula1, Len(TextoDigitado))) = UCase(TextoDigitado) Or UCase(Left(TextoCelula2, Len(TextoDigitado))) = UCase(TextoDigitado) Then
               With ListBox1
               
                               .ColumnCount = 2
                               .AddItem
                               .List(k, 0) = TextoCelula2
                               .List(k, 1) = TextoCelula1
               End With
          
                
            End If
            i = i + 1
            k = k + 1
        Wend
    End With
End Sub