Obligado a buscar Seleccionando en el Combo "Buscar Por"
Hola Dam
Espero encontrar tu respuesta para corregir la macro porque se que en 6 Abril del 2013, me respondiste pero realmente no encuentro dicha respuesta y tampocotengo dicha corrección en el Libro, no se que pasó.
Mi pregunta y requerimiento, están en la hoja1 donde el fondo de celda está en ROJO 1º punto.
Hay otros más pero quiero ver si alguno logro remendarlo, si no pues tendré que recorrer al supremo
Te dejo enlace al libro. http://depositfiles.org/files/m55mys0xl
Si no logras bajarlo, te lo enviaré, sabes por cual vía
Gracias
1 Respuesta
No puedo descargarlo. Envíamelo a mi correo, no olvides poner tu nombre en el asunto.
Prueba con esto
Private Sub buscar_Change() Application.ScreenUpdating = False ' lista.RowSource = "" If Buscar = "" Then Exit Sub If FiltrarPor = "" Then MsgBox "Seleccione algún critério en Buscar cliente por" Exit Sub End If lista.RowSource = "" Sheets("Clientes").Range("A:G").Copy Sheets("Filtro").Range("A1") Sheets("Filtro").Range("A2:G2").Insert Shift:=xlDown Sheets("Filtro").Range("B2:G2") = "" Sheets("Filtro").Range("A2") = Buscar 'Buscar por CODIGO If FiltrarPor.ListIndex = 1 Then 'Buscar por NOMBRE Sheets("Filtro").Range("A2") = "" Sheets("Filtro").Range("B2") = Buscar End If If FiltrarPor.ListIndex = 2 Then 'Buscar por CIUDAD Sheets("Filtro").Range("A2") = "" Sheets("Filtro").Range("B2") = "" Sheets("Filtro").Range("D2") = Buscar End If Sheets("Filtro").Range("A1:G22").AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Filtro").Range("A1:G2"), _ CopyToRange:=Sheets("Filtro").Range("H1:N22") Sheets("Filtro").Rows(2).Delete fila = Sheets("Filtro").Range("H" & Rows.Count).End(xlUp).Row If fila > 1 Then lista.RowSource = "Filtro!H2:N" & fila Application.ScreenUpdating = True End Sub
1º De ninguna forma, al entrar el formulario, no se presenta el ListBox lleno.
Si me dice que seleccione un criterio en Buscar Por, cierro formulario
Punto 1º + selecciono criterio Código, sigue sin llenarse
Punto 1º + Selecciono criterio Nombre o Ciudad sigue sin llenarse
Punto 1º + Selecciono el criterio Código y busco los primeros caracteres de un código y si muestra pero
Perdoname DAM. La idea es que al entrar el form, este se presente lleno, con todos los datos de la hoja, tal como te envíe el libro, luego:
Si escribo algo en el TextBox Buscar Cliente y que este vacío el combo Buscar Cliente Por (sin que seleccione el criterio por el cual buscar), me mande el mensaje.
Gracias DAm
Saludos
Colocado en esta intentar,
If fila > 1 Then lista.RowSource = "Filtro!H2:N" & fila If Buscar = "" Then Exit Sub If FiltrarPor = "" Then MsgBox "Seleccione algún critério en Buscar cliente por" Exit Sub End If Application.ScreenUpdating = True End Sub
medio funciona, te digo como:
Abre el form y si se presenta lleno.
Sin selección de algún criterio, escribo algo en el TextBox Buscar y m, e manda el mensaje esperado, es correcto pero;
Si escribo algo de la columna Código, si me filtra y me manda mensaje también, aquí está mal ¿idea?, es que nada filtre por ningún lado mientras no haiga nada de criterio seleccionado
Declara la siguiente variable al principio de todo el código
Dim pasar
El evento initialize
Private Sub UserForm_Initialize() 'Por.Dante Amor ' If PedirClave Then 'de la Function PedirClave() FiltrarPor.AddItem "CÓDIGO" FiltrarPor.AddItem "NOMBRE" FiltrarPor.AddItem "CIUDAD" pasar = 1 buscar_Change pasar = 0 'Carga Combo cmb_Pago cmb_Pago.List = Array("De Contado (Efectivo)", "De Contado con T.Débito", "De Contado con T.Crédito", _ "Pago Con Cheque", "Depósito/Transferencia", "Crédito 3 Días hábiles", "Crédito 7 Días hábiles", _ "Crédito 15 Días Hábiles", "Crédito 21 Días hábiles", "Crédito 30 Días hábiles") 'A partir de aqui pertenece a Function PedirClave() ' Else ' End ' End If End Sub
El evento change
Private Sub buscar_Change() Application.ScreenUpdating = False ' lista.RowSource = "" If pasar = 1 Then Else If FiltrarPor = "" Then MsgBox "Seleccione algún critério en Buscar cliente por" pasar = 1 Exit Sub End If End If lista.RowSource = "" Sheets("Clientes").Range("A:G").Copy Sheets("Filtro").Range("A1") Sheets("Filtro").Range("A2:G2").Insert Shift:=xlDown Sheets("Filtro").Range("B2:G2") = "" Sheets("Filtro").Range("A2") = Buscar 'Buscar por CODIGO If FiltrarPor.ListIndex = 1 Then 'Buscar por NOMBRE Sheets("Filtro").Range("A2") = "" Sheets("Filtro").Range("B2") = Buscar End If If FiltrarPor.ListIndex = 2 Then 'Buscar por CIUDAD Sheets("Filtro").Range("A2") = "" Sheets("Filtro").Range("B2") = "" Sheets("Filtro").Range("D2") = Buscar End If Sheets("Filtro").Range("A1:G22").AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Filtro").Range("A1:G2"), _ CopyToRange:=Sheets("Filtro").Range("H1:N22") Sheets("Filtro").Rows(2).Delete fila = Sheets("Filtro").Range("H" & Rows.Count).End(xlUp).Row If fila > 1 Then lista.RowSource = "Filtro!H2:N" & fila Application.ScreenUpdating = True End Sub
Hola DAM
¿Seria mucho pedirte que lo pruebes? Porque, se abre el form, escribes algo del código o otro criterio (Nombre o Ciudad) en Buscar cliente SIN seleccionar ningún criterio, te lo hace bien pero, borra lo que escribiste y vuelve a intentarlo sin criterio seleccionado, principalmente co nel código.
No es mucho pedir. Claro que trato de probar todos los casos o la mayoría, para entregarte una solución completa, pero a veces son varios casos que no alcanzo a probarlos todos, por eso te corresponde probar todo el funcionamiento y revisar lo que haga falta.
Prueba con lo siguiente, después del end if agregué pasar =0
Private Sub buscar_Change() Application.ScreenUpdating = False ' lista.RowSource = "" If pasar = 1 Then Else If FiltrarPor = "" Then MsgBox "Seleccione algún critério en Buscar cliente por" pasar = 1 Exit Sub End If End If pasar = 0 lista.RowSource = "" Sheets("Clientes").Range("A:G").Copy Sheets("Filtro").Range("A1") Sheets("Filtro").Range("A2:G2").Insert Shift:=xlDown Sheets("Filtro").Range("B2:G2") = "" Sheets("Filtro").Range("A2") = Buscar 'Buscar por CODIGO If FiltrarPor.ListIndex = 1 Then 'Buscar por NOMBRE Sheets("Filtro").Range("A2") = "" Sheets("Filtro").Range("B2") = Buscar End If If FiltrarPor.ListIndex = 2 Then 'Buscar por CIUDAD Sheets("Filtro").Range("A2") = "" Sheets("Filtro").Range("B2") = "" Sheets("Filtro").Range("D2") = Buscar End If Sheets("Filtro").Range("A1:G22").AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Filtro").Range("A1:G2"), _ CopyToRange:=Sheets("Filtro").Range("H1:N22") Sheets("Filtro").Rows(2).Delete fila = Sheets("Filtro").Range("H" & Rows.Count).End(xlUp).Row If fila > 1 Then lista.RowSource = "Filtro!H2:N" & fila Application.ScreenUpdating = True End Sub
- Compartir respuesta