ComboBox DropDown

hola, Fabian !

... no lo puedo hacer funcionar... habia hecho unas modificaciones a... las listas desplegables, segun se agregan letras.
... la computadora donde estan haciendo las listas ya no soporta la cantidad de nombres... y funciona como un carro viejo
... suprimi la parte del list box, hasta ahi venia bien.
... que solo muestre los nombres parecidos en el combobox, y no todos como lo hace actualmente.
Lo mismo que hace en el list box lo haga en el combo box... queria... plegar y desplegar el combobox [...]

prueba con los siguientes codigos [estoy asumiendo que el listbox 'ha desaparecido'] :))
[creo que] 'tendras que'... sustituir completamente los codigos anteriores :-(
si cualquier duda [o surgen detalles adicionales]... comentas?
saludos,
hector.
en el modulo de codigo de la hoja con el combobox ==Dim Sig As Integer, Pulsados As Integer, Patron As String, _
Celda As Range, Listando As Boolean, Filtrando As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ComboBox1.Visible = False
Pulsados = 0
With ActiveCell
If .Column = 1 And .Row > 1 And .Row <= [a65536].End(xlUp).Row + 1 Then
ComboBox1.Left = .Left
ComboBox1.Top = .Top - 1
ComboBox1.Width = .Width + 20
ActualizaNombres
End If
End With
End Sub
Private Sub ComboBox1_KeyDown( _
ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Filtrando = True
Select Case KeyCode
Case vbKeyReturn, vbKeyEscape: Filtrando = False: SendKeys "{Esc}"
Case vbKeyBack
If Pulsados > 0 Then Pulsados = Pulsados - 1
Case 32, 48 To 57, 65 To 90, 97 To 122: Pulsados = Pulsados + 1
End Select
End Sub
Private Sub ComboBox1_LostFocus()
If Filtrando Then Exit Sub
If ActiveCell <> "" And ActiveCell <> ComboBox1 Then Exit Sub
If Trim(ComboBox1) <> "" Then ActiveCell = ComboBox1
End Sub
Private Sub ComboBox1_Change()
If Listando Then Exit Sub
If Pulsados = 0 Or ComboBox1 = "" Then ActualizaNombres: Exit Sub
If Filtrando Then ActualizaLista
End Sub
Private Sub ActualizaNombres()
Listando = True
Dim Nombres As New Collection
On Error Resume Next
For Each Celda In Range([a2], [a65536].End(xlUp))
If Trim(Celda) <> "" Then Nombres.Add Celda, CStr(Celda)
Next
With ComboBox1
.Visible = False
.Clear
For Sig = 1 To Nombres.Count: .AddItem Nombres.Item(Sig): Next
.Visible = True
.Activate
.Text = ActiveCell
.DropDown
End With
Listando = False
End Sub
Private Sub ActualizaLista()
Application.ScreenUpdating = False
Dim Parecidos As New Collection
Patron = LCase(Left(ComboBox1, Pulsados))
On Error Resume Next
For Each Celda In Range([a2], [a65536].End(xlUp))
If LCase(Left(Celda, Pulsados)) = Patron Then Parecidos.Add Celda, CStr(Celda)
Next
With ComboBox1
.Visible = False
.Clear
For Sig = 1 To Parecidos.Count: .AddItem Parecidos.Item(Sig): Next
.Visible = True
.Activate
.Text = Patron
.DropDown
End With
Filtrando = False
End Sub

Como siempre, mejoraste el codigo anterior. Gracias.
Saludos
Fabian

Una consulta: se puede actualizar la lista a partir de la coleccion, o sea
que actualice con la coleccion y no con las celdas a partir del segundo
caracter de busqueda, el primero invariablemente hara la busqueda en las
celdas para obtener la coleccion. Esta opcion aceleraria notablemente la
busqueda. Gracias Hector!
Private Sub ActualizaLista()
Application.ScreenUpdating = False
Dim Parecidos As New Collection
Patron = LCase(Left(ComboBox1, Pulsados))
On Error Resume Next

Si pulsados es igual a 1 caracter entonces

For Each Celda In Range([a2], [a65536].End(xlUp))
If LCase(Left(Celda, Pulsados)) = Patron Then Parecidos.Add Celda,
CStr(Celda)
Next

sino

Para cada item de Parecidos
Si Item,Pulsados=Patron Entonces Parecidos.Agregar Item
proximo
fin

With ComboBox1
.Visible = False
.Clear
For Sig = 1 To Parecidos.Count
.AddItem Parecidos.Item(Sig)
Next
.Visible = True
.Activate
.Text = Patron
.DropDown
End With
Filtrando = False
End Sub

hola, Fabian !

... actualizar la lista a partir de la coleccion... y no con las celdas... aceleraria notablemente la busqueda [...]

[ciertamente que] cuando la rapidez es 'objeto de preocupacion'... los objetos 'collection' NO son 'la mejor opcion'
[ademas] para poder 'aprovechar' una coleccion [o matriz] ya establecida es necesario 'tenerla disponible/global'
[lo que] podria hacerse con una matriz 'redim'ensionable u 'otro tipo' de objetos [me fui por la segunda opcion]
las modificaciones que le hice al codigo [aunque son pocas prefiero] te listo de nuevo [todos] los codigos
NOTA: se requiere establecer una referencia en el proyecto de macros [vba -> herramientas / referencias]...
a la biblioteca de objetos 'Microsoft Scripting Runtime' <= OJO
[para usar un objeto de tipo 'diccionario' en lugar de andar redimensionando matrices o usando 'collections']

si cualquier duda... comentas?
saludos,
hector.
en el modulo de codigo de la hoja con el combobox ==Private Nombres As Scripting.Dictionary
Dim Sig As Integer, Pulsados As Integer, Celda As Range, _
Listando As Boolean, Filtrando As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ComboBox1.Visible = False
Pulsados = 0
With ActiveCell
If .Column = 1 And .Row > 1 And .Row <= [a65536].End(xlUp).Row + 1 Then
ComboBox1.Left = .Left
ComboBox1.Top = .Top - 1
ComboBox1.Width = .Width + 20
ActualizaNombres
End If
End With
End Sub
Private Sub ComboBox1_KeyDown( _
ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Filtrando = True
Select Case KeyCode
Case vbKeyReturn, vbKeyEscape
Filtrando = False
SendKeys "{Esc}"
Case vbKeyBack
If Pulsados > 0 Then Pulsados = Pulsados - 1
Case 32, 48 To 57, 65 To 90, 97 To 122
Pulsados = Pulsados + 1
End Select
End Sub
Private Sub ComboBox1_LostFocus()
If Filtrando Then Exit Sub
If ActiveCell <> "" And ActiveCell <> ComboBox1 Then Exit Sub
If Trim(ComboBox1) <> "" Then ActiveCell = ComboBox1
End Sub
Private Sub ComboBox1_Change()
If Listando Then Exit Sub
If Pulsados = 0 Or ComboBox1 = "" Then ActualizaNombres: Exit Sub
If Filtrando Then ActualizaLista
End Sub
Private Sub ActualizaNombres()
Listando = True
Dim Nombre
Set Nombres = New Scripting.Dictionary
For Each Celda In Range([a2], [a65536].End(xlUp))
Nombre = Trim(Celda)
If Nombre <> "" Then If Not Nombres.Exists(Nombre) Then Nombres.Add Nombre, Nombre
Next
With ComboBox1
.Visible = False
.Clear
For Each Nombre In Nombres.Items: .AddItem Nombre: Next
.Visible = True
.Activate
.Text = ActiveCell
.DropDown
End With
Listando = False
End Sub
Private Sub ActualizaLista()
Application.ScreenUpdating = False
Dim Patron As String, Nombre
Patron = LCase(Left(ComboBox1, Pulsados))
With ComboBox1
.Visible = False
.Clear
For Each Nombre In Nombres.Items
If LCase(Left(Nombre, Pulsados)) = Patron Then .AddItem Nombre
Next
.Visible = True
.Activate
.Text = Patron
.DropDown
End With
Filtrando = False
End Sub

Como siempre, gracias por tus conocimientos invaluables.
Gracias Hector, saludos.
Fabian.