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