Macro demora mucho al Ejecutar

Hola Amigos, tengo un formulario de búsqueda de datos, el cual busca y filtra según van ingresando los datos, pero se demora es muy lento al ejecutar, me podrían orientar como podría hacer para volver mas rapido el código.

Private Sub TextBox1_Change()
'Por.DAM
Application.ScreenUpdating = False
Set hf = Sheets("filtro")
hf.Cells.Clear
cod = TextBox1
If IsNumeric(cod) Then
largo = Len(cod)
Rows(1).Copy hf.Range("A1")
j = 2
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Left(Cells(i, "A"), largo) = cod Then
Rows(i).Copy hf.Cells(j, "A")
j = j + 1
End If
Next
Else
cod = cod & "*"
With Sheets("plan")
With .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
.AutoFilter Field:=2, Criteria1:=cod
.Copy hf.Range("A1")
End With
If .AutoFilterMode Then .Range("A1").AutoFilter
End With
End If
With Sheets("plan")
ancho = Int(.Range("A1").Width + 2) & ";" & Int(.Range("a1").Width + 2)
End With
uf = hf.Range("A" & Rows.Count).End(xlUp).Row
If uf > 1 Then
With Me.ListBox1
.ColumnCount = 2
.ColumnHeads = True
.RowSource = "filtro!A2:B" & uf
.ColumnWidths = ancho
End With
End If
Application.ScreenUpdating = True
End Sub

Gracias