Como Buscar Datos Entre Rango de Numeros y Cargar en Listbox en Forma Automatica





Este pos responde a una pregunta formulada por un suscriptor del canal de you tube donde se requería buscar entre un rango de datos consistentes en números, en la variante que se presenta en este post, la búsqueda de datos es automática, es decir no se necesita que se presione un botón o enter para iniciar la búsqueda de datos.

La macro detecta que se ingresó el número final del rango, valida previamente el número inicial cargado y procede a la búsqueda de los registros en forma inmediata, cargando las coincidencias en el listbox que se encuentra en el formulario.

Existen otros post bastante relacionados que quizás sean de utilidad o ayuden a profundizar los conocimientos con el tema de búsqueda de datos entre un rango de fechas.

Como buscar por un rango de fechas y por cliente
Como buscar por un rango de fechas.
Buscar por un rango de números y cliente

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

La macro en acción se puede ver en el vídeo con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.







   


Desde el final del post se puede descargar el ejemplo en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad, Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

En esta variante de búsqueda de datos en un rango de números, la búsqueda se realiza en forma automática al detectar la macro que se ha ingresado en rango final de números buscados.

Ingresando el número inicial en el textbox número desde, procede a la búsqueda del dato coincidente, que es único, si se ingresa el número en el textbox número hasta, se forma un rango de datos a buscar que la macro busca en forma inmediata, ya que detecta que se ha ingresado el número final del rango de datos buscado, previa validación que sea mayor que el dato inicial.

Con el código siguiente se válida que solo se pueda ingresar números en el textbox de número inicial, también es incorporada la codificación en el textbox número final, con ello el textbox solamente admite el ingreso de números y de ningún otro carácter.


Tex = Me.TextBox1.Value
Lar = Len(Me.TextBox1.Value)
For i = 1 To Lar
Car = Mid(Tex, i, 1)
If Car <> "" Then
If Car < Chr(48) Or Car > Chr(57) Then
If Car = Chr(47) Then GoTo ir:
TextBox1.Value = Replace(Tex, Car, "")
End If
End If
ir:
Next i

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como enviar mail desde Excel adjuntando PDF


Como guardar un archivo en cualquier escritorio 

Formulario de VBA para insertar datos

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

En ambos datos casos una vez encontrados los datos coincidentes se cargan al listbox con el siguiente código:

For i = 2 To uf
   strg = b.Cells(i, 1).Value
   If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i


En el textbox que se utiliza para cargar el rango final de datos se procede a realizar una validación de datos antes de ejecutar la macro ello se logra con las siguientes codificaciones:

El código siguiente es lo que hace que la macro se ejecute cuando se ingresen los datos en forma automática sin presionar enter, no necesitando un botón para ejecutar la macro, la macro detecta la cantidad de caracteres ingresados en el textbox destinado a la carga del número inicial, estos caracteres deben ser iguales a los ingresados en el número final, si se cumple ese requisito se empieza a ejecutar la macro de búsqueda, pero previo se realizan otras validaciones.

If Len(Me.TextBox2.Value) = Len(Me.TextBox3.Value) Then


La macro detecta que se haya ingresado una fecha inicial con el siguiente código, en caso que no se cumpla con el ingreso del dato inicial del rango, la macro termina su ejecución con Exit Sub.

If TextBox2 = Empty Then
MsgBox ("Debe ingresar número de comprobante inicial para consultar por rango"), vbCritical, "AVISO"
TextBox2.SetFocus
Exit Sub
End If

Otra validación importante que hace la macro es establecer si el número final es mayor al inicial, caso contrario la macro termina su ejecución, esto se realiza con el siguiente código:

dato1 = Val(TextBox2)
dato2 = Val(TextBox3)
If dato2 < dato1 Then
MsgBox ("El número final no puede ser menor al número inicial"), vbCritical, "AVISO"
Exit Sub
End If

Desde el final se puede descargar el ejemplo denominado Como buscar datos entre rango de números y cargar en listbox en forma automática, recuerda mirar el vídeo donde se muestra la macro en acción, unido a la explicación que existe en este post, se podrán entender la macro con bastante facilidad.

Código que se inserta en un formulario

Private Sub CommandButton3_Click()
Unload UserForm1
End Sub


Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
     'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
     Me.ListBox1.RowSource = "Hoja1!A2:G" & uf
   Exit Sub
End If


b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
If dato1 <> Empty Or dato2 <> Empty Then GoTo rango:
If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If
For i = 2 To uf
   strg = b.Cells(i, 1).Value
   If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i

rango:

For i = 2 To uf
   strg = b.Cells(i, 1).Value
   dato0 = CDate(b.Cells(i, 2).Value)
   If UCase(strg) Like UCase(TextBox1.Value) & "*" And dato0 >= dato1 And dato0 <= dato2 Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i

Me.ListBox1.ColumnWidths = "170 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
End Sub

Private Sub TextBox2_Change()
'Valida para que solo se ingrese número
Dim Tex As Variant, Car As Variant, Lar As Integer
Dim dato0 As Variant, dato1 As Variant
On Error Resume Next


Tex = Me.TextBox1.Value
Lar = Len(Me.TextBox1.Value)
For i = 1 To Lar
Car = Mid(Tex, i, 1)
If Car <> "" Then
If Car < Chr(48) Or Car > Chr(57) Then
If Car = Chr(47) Then GoTo ir:
TextBox1.Value = Replace(Tex, Car, "")
End If
End If
ir:
Next i


If Len(Me.TextBox2.Value) > 0 Then

Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
dato1 = Val(TextBox2)

If dato1 = Empty Then
MsgBox ("Debe ingresar número a consultar"), vbCritical, "AVISO"
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem

For i = 2 To uf
   dato0 = Val(b.Cells(i, 6).Value)
   If dato0 = dato1 Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i

'Carga los datos de la cabecera en listbox
For ii = 0 To 6
UserForm1.ListBox1.List(0, ii) = b.Cells(1, ii + 1)
Next ii
Me.ListBox1.ColumnCount = 7
Me.ListBox1.ColumnWidths = "170 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt" 'la columna 3 y 6 no tiene datos por eso no se ve pero esta en listbox

TextBox1 = Clear
TextBox3 = Clear

Else 'esto es por si ya esta cargado y se quita algun digito borre el listbox para que no quede las coincidencias anteriores
UserForm1.ListBox1.Clear

End If

End Sub

Private Sub TextBox3_Change()
'Valida para que solo se ingrese número
Dim Tex As Variant, Car As Variant, Lar As Integer
Dim dato0 As Variant, dato1 As Variant, dato2 As Variant
On Error Resume Next
'If saltafil = 1 Then GoTo sal1: 'controla que al eliminar filtro salte los evento change


Tex = Me.TextBox3.Value
Lar = Len(Me.TextBox3.Value)
For i = 1 To Lar
Car = Mid(Tex, i, 1)
If Car <> "" Then
If Car < Chr(48) Or Car > Chr(57) Then
If Car = Chr(47) Then GoTo ir:
TextBox3.Value = Replace(Tex, Car, "")
End If
End If
ir:
Next i


'En caso que se haya cargado la fecha completa procede a la busqueda antes estaba evento afterupdate
If Len(Me.TextBox2.Value) = Len(Me.TextBox3.Value) Then


If TextBox2 = Empty Then
MsgBox ("Debe ingresar número de comprobante inicial para consultar por rango"), vbCritical, "AVISO"
TextBox2.SetFocus
Exit Sub
End If


Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
dato1 = Val(TextBox2)
dato2 = Val(TextBox3)
If dato2 = Empty Or dato1 = Empty Then
MsgBox ("Debe ingresar datos para consulta entre rango de números"), vbCritical, "AVISO"
Exit Sub
End If
If dato2 < dato1 Then
MsgBox ("El número final no puede ser menor al número inicial"), vbCritical, "AVISO"
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem

For i = 2 To uf
   dato0 = Val(b.Cells(i, 6).Value)
   If dato0 >= dato1 And dato0 <= dato2 Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i

'Carga los datos de la cabecera en listbox
For ii = 0 To 6
UserForm1.ListBox1.List(0, ii) = b.Cells(1, ii + 1)
Next ii
Me.ListBox1.ColumnCount = 7
Me.ListBox1.ColumnWidths = "170 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt" 'la columna 3 y 6 no tiene datos por eso no se ve pero esta en listbox

TextBox1 = Clear

Else 'esto es por si ya esta cargado y se quita algun digito borre el listbox para que no quede las coincidencias anteriores
UserForm1.ListBox1.Clear

End If
End Sub


Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
    .ColumnCount = 7
    .ColumnWidths = "170 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
    '.RowSource = "Hoja1!A2:" & wc & uf
End With

b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem

For i = 2 To uf
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Next i

'Carga los datos de la cabecera en listbox
For ii = 0 To 6
UserForm1.ListBox1.List(0, ii) = b.Cells(1, ii + 1)
Next ii

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub

Código que se inserta en un módulo

Sub muestra1()
UserForm1.Show
End Sub


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends