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 SubEl 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
