Eu tenho esse código que basicamente filtra os valores na caixa de listagem como o valor muda na caixa de texto no userform no excel

Private Sub TextBox1_Change()

Dim sht As Worksheet
Dim rng1 As Range
Set sht = Sheet5
Set rng1 = sht.Range("F2:F" & sht.Range("F" & sht.Rows.Count).End(xlUp).Row)

ListBox2.ColumnCount = 7

'=====
Dim i As Long
Dim arrList As Variant

Me.ListBox2.Clear
If sht.Range("F" & sht.Rows.Count).End(xlUp).Row > 1 Then
    arrList = sht.Range("F2:L" & sht.Range("F" & sht.Rows.Count).End(xlUp).Row).Value2
    For i = LBound(arrList) To UBound(arrList)
        If InStr(1, arrList(i, 1), Trim(Me.TextBox1.Value), vbTextCompare) Then
            liste = ListBox2.ListCount
            Me.ListBox2.AddItem
            Me.ListBox2.List(liste, 0) = arrList(i, 1)
            Me.ListBox2.List(liste, 1) = arrList(i, 2)
            Me.ListBox2.List(liste, 2) = arrList(i, 3)
            Me.ListBox2.List(liste, 3) = arrList(i, 4)
            Me.ListBox2.List(liste, 4) = arrList(i, 5)
            Me.ListBox2.List(liste, 5) = arrList(i, 6)
            Me.ListBox2.List(liste, 6) = arrList(i, 7)

        End If
    Next i
End If

If Me.ListBox2.ListCount = 1 Then Me.ListBox2.Selected(0) = True

End Sub

Funciona perfeitamente, exceto quando altero o valor de algo para nada, ou seja, em branco leva de 4 a 5 segundos para concluir o preenchimento de cerca de 8k linhas * 7 colunas de dados da planilha na caixa de listagem, o que não é desejável. Existe alguma maneira de acelerar as coisas aqui?