Código para formulario buscar clientes, por qué no busca mas de una letra en el textbox nombre?

Alguien por favor que me ayude con esto.

Este código para un formulario de buscar clientes funciona bien, pero en el cuadro textbox "nombre" cuando intento poner mas de una letra no me aparece nada en el cuadro listbox. Gracias.

Private Sub TXTBUSCACLI_Change()

Application.ScreenUpdating = False
Sheets("CLI").Select
Range("B2").Select
LSTCLI.Clear
While ActiveCell.Value <> ""
M = InStr(1, ActiveCell.Value, UCase(TXTBUSCACLI.Text))
If M > 0 Then
LSTCLI.ColumnCount = 6
LSTCLI.AddItem
ActiveCell.Offset(0, -1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 0) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 1) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 2) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 3) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 4) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 5) = ActiveCell.Value
ActiveCell.Offset(0, -4).Select
End If
ActiveCell.Offset(1, 0).Select

Wend

Sheets("FACTURA").Select
Range("A1").Select

Application.ScreenUpdating = True
End Sub

Private Sub TXTBUSCACLI2_Change()
Application.ScreenUpdating = False
Sheets("CLI").Select
Range("D2").Select
LSTCLI.Clear
While ActiveCell.Value <> ""
M = InStr(1, ActiveCell.Value, UCase(TXTBUSCACLI2.Text))
If M > 0 Then
LSTCLI.ColumnCount = 6
LSTCLI.AddItem
ActiveCell.Offset(0, -3).Select
LSTCLI.List(LSTCLI.ListCount - 1, 0) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 1) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 2) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 3) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 4) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 5) = ActiveCell.Value
ActiveCell.Offset(0, -2).Select
End If
ActiveCell.Offset(1, 0).Select

Wend

Sheets("FACTURA").Select
Range("A1").Select

Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Activate()
Application.ScreenUpdating = False

Sheets("CLI").Select
Range("A2").Select

While ActiveCell.Value <> ""
ActiveCell.Offset(0, 9).Select

If ActiveCell.Value = 0 Then
ActiveCell.Offset(0, -9).Select
LSTCLI.ColumnCount = 6
LSTCLI.AddItem
LSTCLI.List(LSTCLI.ListCount - 1, 0) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 1) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 2) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 3) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 4) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LSTCLI.List(LSTCLI.ListCount - 1, 5) = ActiveCell.Value
ActiveCell.Offset(1, -5).Select
Else
ActiveCell.Offset(1, -9).Select
End If

Wend

Sheets("FACTURA").Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Private Sub LSTCLI_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False

On Error GoTo ERR:
L = LSTCLI.List(LSTCLI.ListIndex, 0)
Sheets("CLI").Select
Range("A2").Select

While ActiveCell.Value <> "" And ActiveCell.Value <> Val(L)
ActiveCell.Offset(1, 0).Select
Wend

If ActiveCell.Value = "" Then
MsgBox "NO EXISTE USUARIO"
Unload Me
FRMBUSCARCLIENTE.Show
Else

If DON4 = "MODCLI" Then

DON5 = ActiveCell.Value

Unload Me

FRMNUEVOCLIENTE.Show

Sheets("PRINCIPAL").Select
Range("C6").Select

Else
COD1 = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
NOMB1 = ActiveCell.Value

Sheets("FACTURA").Select
Range("C11").Select
ActiveCell.Value = NOMB1
Range("C11").Select
Unload Me
End If

End If
ERR:
Application.ScreenUpdating = True
End Sub

1 Respuesta

Respuesta
2

H o l a:

En este evento txtbuscacli_change 
Tienes que cambiar esto:

m = instr(1, activecell.value, ucase(txtbuscacli.text))

Por esto:

m = instr(1, ucase(activecell.value), ucase(txtbuscacli.text))

Es decir, tienes que comparar mayúsculas con mayúculas, lo mismo para el evento: TXTBUSCACLI2_Change

Cambia esto:

M = InStr(1, ActiveCell.Value, UCase(TXTBUSCACLI2.Text))

Por esto:

M = InStr(1, ucase(ActiveCell.Value), UCase(TXTBUSCACLI2.Text))


Muchísimas gracias Dante Amor.

La verdad que usted es un genio.

Siempre respuestas rápidas y concreta. Gracias...

Le deseo lo mejor en su vida.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas