Autofiltro, combo y listbox

Hola de nuevo,

Posiblemente sea abusar mucho el hacer dos consultas seguidas, pero estoy
enfrascado en una aplicacion que empieza a eternizarse, y uno de los
principales flecos que me quedan es el de la velocidad. Asi que he
decidido arriesgame a una incorreccion. Espero que no moleste a nadie, y
si es asi le pido disculpas de antemano.

Tengo un formulario con un combobox que se rellena con registros unicos de
un campo elegido en funcion de un optionbutton(entre seis optb), y que a
la vez rellena un litbox con las coincidencias segun se pulsa el teclado
en el combo. Funciona aceptablemente bien con pocos registros, pero cuando
el nº es grande (pej: 10.000), le cuesta bastante. He intentado usar
autofiltros en funcion del criterio elegido en el combo para que la
busqueda sea con menos registros, pero a pesar de probar numerosas formas
(casi todas ellas sacadas del foro) no lo consigo. Posiblemente se deba a
que no los aplico en el evento/momento adecuado (aparte de que no acabo de
comprender su sintaxis), he probado en change del combo, pero posiblemente
entre en "conflicto" con los "pulsos" (es un suponer) del teclado y por
eso no da resultado.

A continuacion expongo los codigos que creo intervienen en el proceso. Son
unos cuantos, pero quizas sea la unica forma de mostrarlo en condiciones.
Por cierto, una buena parte estan desarrollados a partir de codigos de
respuestas de expertos ( HM, KL, ..) en el foro. Muchas gracias de nuevo,
y espero no haberoslos desgraciado mucho.

-Codigos

'' He añadido la eñe, el punto y la coma (creo)
Private Sub cmbCriterio_KeyDown(ByVal KeyCode As MSForms _
.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
Select Case KeyCode
Case vbKeyReturn, vbKeyEscape
SendKeys "{Esc}"
Case vbKeyBack
If Pulsos > 0 Then Pulsos = Pulsos - 1
Case 32, 46, 48 To 57, 65 To 90, 97 To 122, 241
Pulsos = Pulsos + 1
End Select
Application.ScreenUpdating = True
End Sub



Private Sub cmbCriterio_Change()
With lstSeleccionar: Num = 0: .Clear: .ColumnCount = 4
LlenarLista
txtNroLibros = .ListCount: End With
End Sub



Private Sub optTitulo_Click()
lstSeleccionar.Clear: Num = 0
Pulsos = 0: Patron = ""
strCombo = "b2:b": rngOrd = "b"
RellenarCombo
cmbCriterio.SetFocus
End Sub




Private Sub optAutor_Click()
lstSeleccionar.Clear: Num = 0
Pulsos = 0: Patron = ""
strCombo = "c2:c": rngOrd = "c"
RellenarCombo
cmbCriterio.SetFocus
End Sub

-

Private Sub RellenarCombo()
Dim Unicos As New Collection
Application.ScreenUpdating = False
With Worksheets("Listado")
Y = .Range("a65536").End(xlUp).Row

''' strCombo y rngOrd voy a cambiarlos a los optButton directamente:
'If optTitulo = True Then
' strCombo = "b2:b": rngOrd = "b"
'ElseIf optAutor = True Then
' strCombo = "c2:c": rngOrd = "d"
'ElseIf optGenero = True Then
' strCombo = "d2:d": rngOrd = "e"
'ElseIf optTema = True Then
' strCombo = "e2:e": rngOrd = "f"
'ElseIf optPais = True Then
' strCombo = "f2:f": rngOrd = "g"
'ElseIf optHermano = True Then
' strCombo = "g2:g": rngOrd = "h"
'ElseIf optApellido = True Then
' strCombo = "l2:l": rngOrd = "l"
'End If
If chkOrdenar = True Then _
.Range(.Range("a1"), .Range("l" & Y)).Sort _
key1:=.Range(rngOrd & "1"), header:=xlYes
Set rngCombo = .Range(strCombo & Y)
On Error Resume Next
For Each Celda In rngCombo
If Trim(Celda) <> "" Then Unicos.Add Celda, CStr(Celda)
Next
With cmbCriterio: .Clear: .ListIndex = -1: End With
With lstSeleccionar: .Clear: .ListIndex = -1: End With
For Sig = 1 To Unicos.Count
cmbCriterio.AddItem Unicos.Item(Sig)
Next
End With
Set Unicos = Nothing
Application.ScreenUpdating = True
End Sub



Private Sub LlenarLista()
Dim filH As Long, ac As Single
If Not Pulsos > 0 Then Exit Sub
Patron = Trim(LCase(Left(cmbCriterio, Pulsos)))
Application.ScreenUpdating = False
With Worksheets("Listado")
.Range(.Range("a1"), .Range("l" & Y)).Sort _
key1:=.Range("a1"), header:=xlYes
End With
For Each Celda In rngCombo
With Celda
If Trim(LCase(Left(.Value, Pulsos))) = Patron Then
filH = .Row
With lstSeleccionar
.TextColumn = 1
.AddItem
For ac = 0 To .ColumnCount - 1
.List(Num, ac) = Range("a" & filH & ":d" & filH)(ac + 1).Value
Next ac
Num = Num + 1
End With
txtNroLibros = lstSeleccionar.ListCount
End If
End With
Next
Application.ScreenUpdating = True
End Sub

En cualquier caso muchas gracias
Un saludo y hasta pronto
Ivan