REALIZAR BÚSQUEDAS DEPENDIENTES EN UN LISTBOX

Hola a todos : )

Hace unos días me enviaron una consulta en la que me solicitaban la necesidad de poder realizar consultas dependientes en un listbox.

Sobre el tema de las consultas dependientes, ya había tratado algo en esta entrada: COMBOBOX DEPENDIENTES EN USERFORM CON SQL , solo que esa ocasión estaba utilizando combobox.

En concreto, en esa consulta el filtro debería hacerse sobre un único listbox y utilizando varios textbox para indicar los items por los que realizar el filtrado.

Utilizará la base de datos de empleados de unos grandes almacenes (ya es un clásico en esta web) y pasaré los datos a un listbox:

Esta es la base de datos:

REALIZAR BUSQUEDAS DEPENDIENTES EN UN LISTBOX

Y mediante este código pasamos la información al listbox:

Private Sub UserForm_Initialize()
'Indicamos el número de columnas que tendrá el listbox
Me.ListBox1.ColumnCount = 7
'Definimos tamaño de los espacios
Me.ListBox1.ColumnWidths = "30pt;150pt;150pt;50pt;50pt;60pt"
'Cargamos listbox
Me.ListBox1.RowSource = ("A2:G") & Worksheets("BBDD").Range("A" & Rows.Count).End(xlUp).Row
End Sub

Aquí ya tenemos la información cargada:

REALIZAR BUSQUEDAS DEPENDIENTES EN UN LISTBOX2

Pero ahora debemos filtrar según nuestras necesidades. Para este ejemplo realizaré un secuencia de tres consultas dependientes: Primero filtramos por Sección, una vez tengamos esos datos, filtramos por Estudios y finalmente, filtraremos por Idioma.

Para ello es necesario crear tres textbox, y en cada uno de ellos realizar la programación correspondiente. Os dejo el código de cada textbox:

TextBox1 – Filtrar por Sección:

Private Sub TextBox1_Change()
'Declaramos variables
Dim fin As Long, i As Long, n As Long
Dim sCadena_seccion As String
'Filtramos por sección
With Sheets("BBDD")
fin = Application.CountA(.Range("A:A"))
If TextBox1 = "" Then
Me.ListBox1.RowSource = ("A2:G") & Worksheets("BBDD").Range("A" & Rows.Count).End(xlUp).Row
Exit Sub
End If
Me.TextBox2 = Clear
Me.TextBox3 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To fin
sCadena_seccion = .Cells(i, 3).Value
If UCase(sCadena_seccion) Like "*" & UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem
Me.ListBox1.List(n, 0) = .Cells(i, 1).Value
Me.ListBox1.List(n, 1) = .Cells(i, 2).Value
Me.ListBox1.List(n, 2) = .Cells(i, 3).Value
Me.ListBox1.List(n, 3) = .Cells(i, 4).Value
Me.ListBox1.List(n, 4) = .Cells(i, 5).Value
Me.ListBox1.List(n, 5) = .Cells(i, 6).Value
Me.ListBox1.List(n, 6) = .Cells(i, 7).Value
n = n + 1
End If
Next
Me.ListBox1.ColumnWidths = "30pt;150pt;150pt;50pt;50pt;60pt"
End With
End Sub

TextBox2 – Filtrar por Estudios:

Private Sub TextBox2_Change()
Dim fin As Long, i As Long, n As Long
Dim sCadena_seccion As String, sCadena_estudios As String
'Una vez filtrados los datos por sección, filtramos por estudios
With Sheets("BBDD")
fin = Application.CountA(.Range("A:A"))
If TextBox2 = "" Then
Me.ListBox1.RowSource = ("A2:G") & Worksheets("BBDD").Range("A" & Rows.Count).End(xlUp).Row
Exit Sub
End If
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To fin
sCadena_seccion = .Cells(i, 3).Value
sCadena_estudios = .Cells(i, 7).Value
If UCase(sCadena_seccion) Like "*" & UCase(TextBox1.Value) & "*" And _
UCase(sCadena_estudios) Like "*" & UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem
Me.ListBox1.List(n, 0) = .Cells(i, 1).Value
Me.ListBox1.List(n, 1) = .Cells(i, 2).Value
Me.ListBox1.List(n, 2) = .Cells(i, 3).Value
Me.ListBox1.List(n, 3) = .Cells(i, 4).Value
Me.ListBox1.List(n, 4) = .Cells(i, 5).Value
Me.ListBox1.List(n, 5) = .Cells(i, 6).Value
Me.ListBox1.List(n, 6) = .Cells(i, 7).Value
n = n + 1
End If
Next
Me.ListBox1.ColumnWidths = "30pt;150pt;150pt;50pt;50pt;60pt"
End With
End Sub

TextBox3 – Filtrar por Idiomas:

Private Sub TextBox3_Change()
Dim fin As Long, i As Long, n As Long
Dim sCadena_seccion As String, sCadena_estudios As String, sCadena_idioma As String
'una vez filtrada la información por sección y estudios, filtramos por idioma

With Sheets("BBDD")

fin = Application.CountA(.Range("A:A"))
If TextBox2 = "" Then
Me.ListBox1.RowSource = ("A2:G") & Worksheets("BBDD").Range("A" & Rows.Count).End(xlUp).Row
Exit Sub
End If
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To fin
sCadena_seccion = .Cells(i, 3).Value
sCadena_estudios = .Cells(i, 7).Value
sCadena_idioma = .Cells(i, 6).Value
If UCase(sCadena_seccion) Like "*" & UCase(TextBox1.Value) & "*" And _
UCase(sCadena_estudios) Like "*" & UCase(TextBox2.Value) & "*" And _
UCase(sCadena_idioma) Like "*" & UCase(TextBox3.Value) & "*" Then
Me.ListBox1.AddItem
Me.ListBox1.List(n, 0) = .Cells(i, 1).Value
Me.ListBox1.List(n, 1) = .Cells(i, 2).Value
Me.ListBox1.List(n, 2) = .Cells(i, 3).Value
Me.ListBox1.List(n, 3) = .Cells(i, 4).Value
Me.ListBox1.List(n, 4) = .Cells(i, 5).Value
Me.ListBox1.List(n, 5) = .Cells(i, 6).Value
Me.ListBox1.List(n, 6) = .Cells(i, 7).Value
n = n + 1
End If
Next
Me.ListBox1.ColumnWidths = "30pt;150pt;150pt;50pt;50pt;60pt"
End With
End Sub

Una vez te tenemos el código incluido en todos los controles, ya podemos proceder a probar la herramienta. Probaremos con la siguiente consulta: todos los empleados que pertenezcan a la sección de “Bricolaje“, que en sus estudios sean “Diplomados” y que sepan “Chino“.

El resultado es el siguiente:

REALIZAR BUSQUEDAS DEPENDIENTES EN UN LISTBOX3

Como podéis observar, el filtro funciona perfectamente y no es necesario escribir la palabra completa en los textbox, basta con ir escribiendo y la información se irá mostrando. En este caso tenemos a dos personas, perfecto!.

Y eso es todo, creo que es un método muy sencillo, donde trabajamos con un loop, un buscador y cargamos información si los parámetros de la consulta coinciden.

Espero que os resulte de interés : )

Descarga el archivo de ejemplo pulsando en: REALIZAR BÚSQUEDAS DEPENDIENTES EN UN LISTBOX

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Anuncios

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABÉTICAMENTE LA INFORMACIÓN

Hola a todos:

En el post anterior hemos visto una nueva técnica para obtener registros únicos usando el objeto “Diccionario”: ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS ÚNICOS EN COMBOBOX Y LISTBOX

Entre las consultas que me enviaron los lectores, una de ellas era sobre si se podían ordenar esos datos una vez eliminados los duplicados y pasar esa información al combobox y al listbox. Como me pareció útil e interesante, he decidido crear un nuevo post como continuación al anterior (de esta forma se verá más claro).

Partiendo de una información diferente, no meses, sino por nombre de personas:

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABETICAMENTE LA INFORMACION

Vamos a hacer el mismo ejercicio que en post anterior, es decir, eliminar duplicados, ordenar la información y pasar los datos a un combobox y a un listbox:

Sub CARGAR_UNICOS_ORDENADOS()
'Declaramos las variables
Dim rango As Range, celda As Object, oDic As Object, npalabra As String
Dim sCadena As String, sCadena1 As String, ipalabra As String, OrdenarAlfa As Variant
Dim matriz As Variant, matriz1 As Variant, palabra As Variant, alfadato As Variant
Dim i As Long, j As Long, fin As Integer
'Trabajamos con la hoja
With Sheets("UNICOS")
'Limpiamos combo y listbox
.ComboBox1.Clear
.ListBox1.Clear
'Definimos el rango de los datos
fin = .Range("A" & Rows.Count).End(xlUp).Row
'Trabajamos con rango establecido
Set rango = .Range("A2:A" & fin)
'Por cada celda del rango componemos un string
For Each celda In rango
If celda <> vbNullString Then
ipalabra = ipalabra & "," & celda
End If
Next celda
'Eliminamos posibles espacios en blanco
sCadena = Trim(Mid(ipalabra, 2, Len(ipalabra)))
'Comprobamos que cada palabra que incluimos en la matriz no existe en cadena
matriz = Split(sCadena, ",")
Set oDic = CreateObject("scripting.dictionary")
For i = 0 To UBound(matriz)
If Not oDic.Exists(matriz(i)) Then oDic.Add matriz(i), matriz(i)
Next i
'Creamos una nueva cadena ya sin duplicados
sCadena1 = Join(oDic.Keys, ",")
'Pasamos los datos a una matriz
Set matriz1 = CreateObject("System.Collections.ArrayList")
'Y ordenamos las palabras
For Each palabra In Split(sCadena1, ",")
matriz1.Add palabra
Next palabra
matriz1.Sort
'Pasamos de nuevo las palabras ordenadas a un string
For Each alfadato In matriz1
npalabra = npalabra & "," & alfadato
Next alfadato
OrdenarAlfa = Split(Trim(Mid(npalabra, 2, Len(npalabra))), ",")
'Pasamos los datos al Combo y al listbox
For j = 0 To UBound(OrdenarAlfa)
.ComboBox1.AddItem (OrdenarAlfa(j))
.ListBox1.AddItem (OrdenarAlfa(j))
Next
'Limpiamos variable de objeto
Set rango = Nothing
Set oDic = Nothing
End With
End Sub

Si vais observando la construcción de la macro, podéis ver que hemos incluido un pequeño subproceso en el código a través del cual volvemos a pasar los datos del rango a una matriz y los ordenamos con la propiedad “.sort”.

El resto del código es igual que el ejemplo anterior, y para que veáis cómo funciona, os dejo el resultado:

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABETICAMENTE LA INFORMACION1

Como podéis observar, hemos conseguir el objetivo propuesto, los datos se han cargado sin duplicados y se han ordenado alfabéticamente.

Descarga el archivo de ejemplo pulsando en: ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABÉTICAMENTE LA INFORMACIÓN

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS ÚNICOS EN COMBOBOX Y LISTBOX

Hola a todos!

El universo de los datos duplicados y su tratamiento es muy variado en Excel, se pueden tratar tanto con fórmulas, con comandos instalados en la hoja y también con vba. El objetivo suele ser siempre trabajar con registros únicos para evitar duplicidades en las informaciones.

En esta web hay varios ejemplos de cómo se pueden obtener registros únicos, hoy os voy a mostrar una nueva variante. Imaginad que tenéis los meses del año en una columna, pero en algunos casos se duplica el nombre de los meses:

ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS UNICOS EN COMBOBOX Y LISTBOX

El objetivo será obtener registros únicos y cargar un combobox y un listbox. Para ello vamos a trabajar con la siguiente macro:

Sub CARGAR_UNICOS()
'Declaramos las variables
Dim rango As Range, oDic As Object, celda As Object
Dim ipalabra As String, matriz1 As Variant, matriz2 As Variant
Dim sCadena1 As String, sCadena2 As String, i As Long, j As Long, Fin As Integer
'Trabajamos con la hoja
With Sheets("UNICOS")
'Limpiamos combo y listbox
.ComboBox1.Clear
.ListBox1.Clear
'Definimos el rango de los datos
Fin = .Range("A" & Rows.Count).End(xlUp).Row
'Trabajamos con rango establecido y creamos objeto diccionario
Set rango = .Range("A2:A" & Fin)
Set oDic = CreateObject("scripting.dictionary")
'Por cada celda con datos en el rango rango componemos un string
For Each celda In rango
If celda <> vbNullString Then
ipalabra = ipalabra & "," & celda
End If
Next celda
'Eliminamos posibles espacios en blanco
sCadena1 = Trim(Mid(ipalabra, 2, Len(ipalabra)))
'Comprobamos que cada palabra que incluimos en la matriz no existe en cadena
matriz1 = Split(sCadena1, ",")
For i = 0 To UBound(matriz1)
If Not oDic.Exists(matriz1(i)) Then oDic.Add matriz1(i), matriz1(i)
Next i
'Creamos una nueva cadena ya sin duplicados
sCadena2 = Join(oDic.Keys, ",")
matriz2 = Split(Trim(sCadena2), ",")
'Pasamos los datos al Combo y al listbox
For j = 0 To UBound(matriz2)
.ComboBox1.AddItem (matriz2(j))
.ListBox1.AddItem (matriz2(j))
Next
'Liberamos memoria
Set rango = Nothing
Set oDic = Nothing
End With
End Sub

Lo que estamos haciendo con este código es: pasar los datos del rango a una variable string con todos los meses (incluidos los repetidos) en una cadena de texto. Si en ese rango existen celdas sin información, no las tendremos en cuenta.

Con el objeto “scripting.dictionary” y mediante un loop, comprobamos si cada palabra “no” existe, en caso afirmativo, la incorporamos de nuevo a la “matriz1”. De esta forma controlamos que no aparezcan registros duplicados en nuestros datos.

A continuación, pasamos los datos a una string y de nuevo a una matriz (matriz2), que nos permitirá con un loop cargar los datos en el Combobox1 y en el Listbox1.

En las partes del código donde hago mención al uso de la coma como delimitador “,” es necesario su utilización para delimitar los elementos de la celda. Si usásemos un espacio en blanco pasaría la segunda, tercera o n palabra como si fuesen otra celda (que puede que también os sea de utilidad para obtener únicos en una única celda).

El resultado es el siguiente:

ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS UNICOS EN COMBOBOX Y LISTBOX1

Como podéis observar, los datos se han cargado correctamente y sin duplicados. Por cierto, para que realicéis pruebas he adjuntado una sencilla macro para vaciar el combobox y el listbox que está vinculada al botón “Vaciar Combo y Listbox”.

Y eso es todo, espero que este método os resulte de interés : )

Descarga el archivo de ejemplo pulsando en: ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS UNICOS EN COMBOBOX Y LISTBOX

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO

Hace unos días recibí una consulta sobre formularios, la petición en concreto era sobre la necesidad de pasar la información seleccionada en varios listbox de un formulario a los mismo listbox pero en otro formulario.

Además, pedía que aunque se seleccionasen listbox diferentes, se pasase la misma información al segundo formulario y sin duplicar los datos.

Aunque puede parecer una consulta sencilla, la especificación de poder seleccionar cualquier item en cualquier listbox y que la información no se duplique durante el proceso, hacen que requiera un desarrollo a medida.

El post anterior, en el que trataba acerca de cargar datos en un listbox y realizar consultas y filtros con SQL y ADO, ya formaba parte de esta consulta, solo que no quería publicar un post demasiado extenso cuando se puede hacer en dos partes y bien explicado 🙂

Por lo tanto, vamos a utilizar el formulario del post: CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL que cargaba los datos que previamente habíamos seleccionado a través de los criterios indicados en un buscador, por ejemplo todos los nombres que contienen una “A”.

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO1

Ahora lo que se pide es pasar los items que queramos seleccionar a un segundo formulario (para nosotros userform2). Por ejemplo así:

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO2

Como podéis ver, seleccionamos en una ocasión el nombre, en otra la asignatura y en otra la calificación.

Para poder exportar esta selección debemos incluir un botón de comando y pegar el siguiente código:

Private Sub CommandButton2_Click()
'Declaramos las variables
Dim i As Integer, j As Integer, n As Integer
Dim Lista As MSForms.ListBox
Dim nLista As MSForms.ListBox
Dim Control As Control
'Contamos el número de Listbox en el formulario
For Each Control In Me.Controls
If TypeName(Control) = "ListBox" Then
Lbox = Lbox + 1
End If
Next
'Primer bucle: recorremos todos los formularios
For j = 1 To Lbox
Set Lista = Me.Controls("Listbox" & j)
'Segundo bucle: por cada formulario, recorremos los item que contiene
'y detectamos el item seleccionado.
For i = 0 To Lista.ListCount - 1
If Lista.Selected(i) = True Then
'Tercer bucle, volvemos a recorrer todos los items
' y si existen varios items seleccionados en la misma fila (misma persona)
'desmarcamos todos menos el primero (evitando así duplicados).
For n = j + 1 To Lbox
Set nLista = Me.Controls("Listbox" & n)
If nLista.Selected(i) = True Then nLista.Selected(i) = False
Next n
'Pasamos los datos seleccionados al formulario 2
UserForm2.ListBox1.AddItem Me.ListBox1.List(i)
UserForm2.ListBox2.AddItem Me.ListBox2.List(i)
UserForm2.ListBox3.AddItem Me.ListBox3.List(i)
UserForm2.ListBox4.AddItem Me.ListBox4.List(i)
UserForm2.ListBox5.AddItem Me.ListBox5.List(i)
End If
Next i
Next j
'Mostramos formulario 2
UserForm2.Show
End Sub

Una vez pulsado el botón, se muestra el formulario 2 con los datos que hemos seleccionado. Es decir, realiza la tarea correctamente.

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO3

Pero ¿qué pasaría si seleccionamos para un mismo item (o persona) varias informaciones?, en lógica si el código importa todo lo seleccionado … ¡duplicaría la información!

Pero esto se soluciona con la siguiente parte del código: donde indicamos que si un ítem ha sido seleccionado varias veces, solo tenga en cuenta la primera de ellas, de esta forma no duplicaremos la información:

For n = j + 1 To Lbox
Set nLista = Me.Controls("Listbox" & n)
If nLista.Selected(i) = True Then nLista.Selected(i) = False
Next n

Os he dejado el código muy comentado para que sea sencillo comprender cómo funciona. Espero que os resulte interesante y os sea de utilidad 🙂

Por supuesto, también está la macro del ejercicio anterior, necesaria para cargar los listbox y hacer las búsquedas.

Por cierto, tanto en este post, como en el anterior, el formulario se abre con el evento Workbook.Open, es decir, en el momento que abrimos el archivo se carga automáticamente el formulario. Es posible que si tenéis activada la seguridad en las macros, en el momento de abrir genere un error. Esto se soluciona guardando el archivo y volviéndolo a abrir, o con un on error resume next (pero no me gusta abusar de este recurso).

Descarga el archivo de ejemplo pulsando en: EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO

CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL

Aunque estoy preparando varios post sobre análisis estadístico de los datos, hoy trataré sobre algo totalmente diferente, los listbox en formularios y la posibilidad de utilizar ADO y las consultas de SQL para buscar y filtrar información.

Vamos seguidamente con un ejemplo para ilustrar el ejercicio. Utilizaré el listado de alumnos que usé para el post de las funciones matriciales, este:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL

Y ahora vamos a construir un sencillo formulario en el que vamos a incluir 5 listbox en los que mostraremos la información de la hoja ALUMNOS y también un cuadro de texto (textbox) y un botón de comando para realizar las búsquedas:

Ahora vamos utilizar el siguiente código VBA que vamos a pegar en el evento click del botón de búsqueda, luego lo iremos comentando:

Private Sub CommandButton1_Click()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection, MiLibro As String
Dim Control As control, Nombre As String
'Vaciamos todos los Listbox
For Each control In Me.Controls
If TypeName(Control) = "ListBox" Then
Control.Clear
End If
Next
'grabamos el dato a buscar, si no hay dato la variable Nombre es nula
Nombre = IIf(UCase(Me.TextBox1.Value) = vbNullString, IsNull(Me.TextBox1.Value), UCase(Me.TextBox1.Value))
'Creamos la instrucción SQL según los parámetros que nos interesan, en este caso, el nombre
'y los diferentes carácteres comodín y el operador "like"
obSQL = "SELECT [ALUMNOS$].* " & _
"FROM [ALUMNOS$] " & _
"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"
'Guardamos el nombre del libro activo para utilizarlo en la conexión ADO
MiLibro = ActiveWorkbook.Name
'Dejamos el cuadro de búsqueda vacío después de iniciar la consulta
Me.TextBox1.Value = vbNullString
'Iniciamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Procedemos a grababar los datos de la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
Do Until Dataread.EOF
'Pasamos la información a cada ListBox a través del recordset
With UserForm1
.ListBox1.AddItem Dataread("ID")
.ListBox2.AddItem Dataread("NOMBRE")
.ListBox3.AddItem Dataread("CLASE")
.ListBox4.AddItem Dataread("ASIGNATURAS")
.ListBox5.AddItem Dataread("CALIFICACIONES")
End With
Dataread.MoveNext
Loop
'Liberamos y cerramos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Con esta macro podremos realizar consultas a través de lo que indiquemos en el cuadro de búsqueda del formulario (textbox1) o lo que es lo mismo, en la variable “Nombre”.

Pero vamos explicando poco a poco el código. Para borrar o limpiar los datos que van a contener los listbox durante las sucesivas búsquedas tenemos que utilizar el siguiente proceso.

For Each control In Me.Controls
If TypeName(Control) = "ListBox" Then
Control.Clear
End If
Next

Una vez que tenemos los listbox libres de datos ya podemos iniciar la consulta SQL:

obSQL = "SELECT [ALUMNOS$].* " & _
"FROM [ALUMNOS$] " & _
"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"

Me gustaría comentar que aquí utilizamos el dato contenido en la variable “Nombre”, importante para poder utilizar el operador Like y por lo tanto, comodines en nuestra consulta.

Cuando la información del cuadro de texto está vacía, simplemente no mostrará nada en los listbox, eso es porque he introducido mediante una condición que si el dato de búsqueda es vacío, entonces es nulo (y por eso no muestra nada).

Nombre = IIf(UCase(Me.TextBox1.Value) = vbNullString, IsNull(Me.TextBox1.Value), UCase(Me.TextBox1.Value))

Podríamos quitar la condición y entonces al pulsar “Buscar” y cargaríamos todos los datos en los listbox, pero creo que así es más funcional.

En la parte condicional de la sentencia SQL, estamos indicando mediante el uso de caracteres comodín, que se busquen los nombres que empiecen por la información escrita en el textbox.

"Where [ALUMNOS$].[NOMBRE] like " & "'" & Nombre & "%'"

Por ejemplo, todos los nombre que empiecen por “MA”:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL2

Si queremos extraer los nombres que acaban en “A”, el código sería así:

"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "'"

Y el resultado este:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL3

Y si quisiéramos que se buscase el nombre a partir de cualquier fragmento de texto, simplemente colocaríamos “%” a ambos lados de la variable “Nombre”:

"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"

y podríamos realizar búsquedas más abiertas, por ejemplo, todos los nombres que contengan “AL” (independientemente si está delante, en el centro o al final). Este es el resultado:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL4

Como podéis observar, la clave está en saber utilizar los caracteres comodín correctamente en la sentencia SQL. Es algo sencillo pero hay que tener especial cuidado con la posición de las comillas simples y los espacios.

Por último, ya sabéis que para este tipo de método es necesario activar la referencia Microsoft ActiveX Data Object 2.8 Library en el editor de VBA.

En el archivo de descarga, la búsqueda de los nombres está condicionada a que contengan parte del dato contenido en el buscador.

Descarga el archivo de ejemplo pulsando en: CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL

SELECCIONAR Y ACTIVAR HIPERVÍNCULO EN LISTBOX

Hace unos días recibía una consulta de cómo insertar y ejecutar hipervínculos desde un formulario, en concreto subir la url de diferentes web y ejecutar el vínculo para que nos direccione a la web que hemos añadido.

Pues bien, lo fundamental es tener claro en qué tipo de control quieres que aparezcan las url´s, para este caso en particular, he sugerido un listbox en propio formulario que cargue las direcciones web desde una página de Excel en la que las vamos añadiendo a una columna.

Partiendo de este ejemplo, vamos a denominar la página como “DATOS” y en la primera columnas, que llamaremos “DIRECCIONES” vamos a ir pegando las páginas que consideremos de nuestro interés.

Ahora, tenemos que añadir un userform y seguidamente un listbox, y para que el listbox cargue los datos, usaremos el siguiente código:

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With Sheets("DATOS")
fin = 2 + Application.CountA(.Range("A:A"))
ListBox1.List = .Range("A2:A" & fin).Value
End With
End Sub

La particularidad de este código es que los datos se cargarán en el listbox cuando pasemos el puntero del ratón justo encima del formulario. Los datos se cargarán siempre a partir de la fila 2 de la primera columna.

Ahora lo siguiente es incluir un código que ejecute la url una vez la hayamos seleccionado en el listbox, para ello, vamos a utilizar esta macro:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
enlace = ListBox1.List(ListBox1.ListIndex)
ActiveWorkbook.FollowHyperlink Address:=enlace, NewWindow:=True
End Sub

Como podéis observar, para capturar el valor del Item seleccionado, utilizamos:

enlace = ListBox1.List(ListBox1.ListIndex)

Una vez que tenemos la url almacenada en “enlace” ya podemos ejecutarla en la siguiente línea:

ActiveWorkbook.FollowHyperlink Address:=enlace, NewWindow:=True

Es necesario que hagáis doble click encima del item seleccionado para ejecutar el hipervínculo.

El resultado es este:

SELECCIONAR Y ACTIVAR HIPERVINCULO EN LISTBOX

* En el archivo que os dejo de descarga he incluido una serie de control de errores para que no salten errores a la hora de descargar el archivo desde el correo, o si modificáis el nombre de la hoja o si pincháis en un ítem vacío del listbox.

Con este sencillo post ya podéis subir vuestros enlaces a un userform, sin problemas.

Descarga el archivo de ejemplo pulsando en: SELECCIONAR Y ACTIVAR HIPERVÍNCULO EN UN LISTBOX