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

Respuesta
1

No puedo descargarlo. Envíamelo a mi correo, no olvides poner tu nombre en el asunto.

¿Será por la página que es? Acabo de bajarlo pero de todos modos acabo de enviartelo.

Gracias

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

Estoy en ello, dame un chance a ver si logro yo y te aviso

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

También te envié el archivo

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas