VBA - Problema al intentar Buscar en varias hojas
Tengo una base de datos de varias hojas, una hoja por año, con 6 campos, y tengo un formulario de búsqueda, que debe mostrar la información de . En el formulario tengo dos criterios de búsqueda, o busca por nombre (busqueda1) o busca por Cédula (busqueda2). Comencé diseñando un código que busca en una sola hoja de la base de datos, y funciona perfectamente, pero cuando intento modificarlo para que busque en todo el libro, usando Un "For Next", el formulario deja de funcionar. No tengo idea de lo que estoy haciendo mal, por eso agradezco la ayuda que me puedan brindar. Este es el código que funciona, pero cuando intento transformarlo para que me busque en varias hojas no lo hace
Private Sub CommandButton1_Click()
On Error GoTo nohay
If busqueda1.Enabled = False Then
Cells.Find(What:=busqueda2, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 1).Select
TextBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox2 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox3 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox4 = ActiveCell
Else
Cells.Find(What:=busqueda1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 2).Select
TextBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox2 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox3 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox4 = ActiveCell
End If
If TextBox1 = "" Then
MsgBox "No se encuentra información con los datos suministrados, intente con datos distintos"
End If
nohay:
End Sub
2 Respuestas
H o l a:
Lo que pasa es que en tu código tienes esta instrucción:
On Error GoTo nohay
Si buscas en la primera hoja y no encuentra, entonces ocurre un error, y se va al final de la macro.
Conservando tu macro, podría quedar así:
Private Sub CommandButton1_Click() 'Por.Dante Amor On Error GoTo nohay For Each h In Sheets h.Activate If busqueda1.Enabled = False Then Cells.Find(What:=busqueda2, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False).Activate 'Cells.FindNext(After:=ActiveCell).Activate ActiveCell.Offset(0, 1).Select TextBox1 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox2 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox3 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox4 = ActiveCell Exit For Else Cells.Find(What:=busqueda1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False).Activate 'Cells.FindNext(After:=ActiveCell).Activate ActiveCell.Offset(0, 2).Select TextBox1 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox2 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox3 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox4 = ActiveCell Exit For End If If TextBox1 = "" Then MsgBox "No se encuentra información con los datos suministrados, intente con datos distintos" End If nohay: Next End Sub
También lo que veo es que estás haciendo una búsqueda en toda la hoja
Cells. Find
Además en la búsqueda tienes el parámetro, para buscar dentro de la celda:
LookAt:=xlPart
Lo que ocasionaría, por ejemplo que si en la columna "D" tienes algo parecido a tu búsqueda, entonces en el textbox1 te va a poner otra información.
Lo que te recomiendo, es lo siguiente:
Primero, que realices la búsqueda del nombre en la columna que le corresponde, por ejemplo, si el nombre está en la columna "A" y la cédula en la columna "B", entonces quedaría así:
Private Sub CommandButton1_Click() 'Por.Dante Amor If busqueda1.Enabled = False Then col = "B" dato = busqueda2 Else col = "A" dato = busqueda1 End If existe = False For Each h In Sheets Set b = h.Columns(col).Find(dato, lookat:=xlPart) If Not b Is Nothing Then TextBox1 = h.Cells(b.Row, "C") TextBox2 = h.Cells(b.Row, "D") TextBox3 = h.Cells(b.Row, "E") TextBox4 = h.Cells(b.Row, "F") existe = True End If Next If existe = False Then MsgBox "No se encuentra información con los datos suministrados, intente con datos distintos" End If End Sub
Segundo, en la macro quitamos la instrucción "On Error", eso lo resolvemos estableciendo en un el objeto b el resultado de la búsqueda:
Set b = h.Columns(col).Find(dato, lookat:=xlPart)
Después de realizar la búsqueda se pregunta si el objeto b es diferente de vacío, eso significa que sí encontró el dato:
If Not b Is Nothing Then
Entonces, se llenan los textbox con los datos encontrados en la hoja, la fila donde encontró el dato y las columnas "C, D, E y F"
TextBox1 = h.Cells(b.Row, "C") TextBox2 = h.Cells(b.Row, "D") TextBox3 = h.Cells(b.Row, "E") TextBox4 = h.Cells(b.Row, "F")
Cualquiera de las 2 macros funciona, pero te recomiendo la segunda.
':) ':)
Como dato adicional, cuando utilizar On Error Goto, en un procedimiento recurrente, llámese For Next, do While, etc, se tiene que deshabilitar la excepción con On Error Goto -1, entonces quedaría:
Private Sub CommandButton1_Click() 'Por.Dante Amor For Each h In Sheets On Error GoTo nohay h.Activate If busqueda1.Enabled = False Then Cells.Find(What:=busqueda2, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False).Activate 'Cells.FindNext(After:=ActiveCell).Activate ActiveCell.Offset(0, 1).Select TextBox1 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox2 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox3 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox4 = ActiveCell Exit For Else Cells.Find(What:=busqueda1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False).Activate 'Cells.FindNext(After:=ActiveCell).Activate ActiveCell.Offset(0, 2).Select TextBox1 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox2 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox3 = ActiveCell ActiveCell.Offset(0, 1).Select TextBox4 = ActiveCell Exit For End If nohay: On Error GoTo -1 Next If TextBox1 = "" Then MsgBox "No se encuentra información con los datos suministrados, intente con datos distintos" End If End Sub
Aún así, te recomiendo la macro que se busca y el resultado se pone en el objeto b
':)
S a l u d o s . D a n t e A m o r
':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.
Gracias Dante Amor, la opción de buscar el resultado y ponerlo en el objeto b funciona perfecto, pero antes el botón Buscar me servía para hallar otras celdas que coincidieran con mi criterio de búsqueda, usando el FindNext, que me recomiendas para solucionar esa parte?
H o l a:
Supongo que quieres buscar el valor en la hoja1, presionar el botón y buscar el siguiente valor en la misma hoja, hasta llegar al último valor, y entonces, pasar al primer valor de la hoja2, presionar el botón y buscar el siguiente dentro de la hoja2 hasta llegar al último y luego que pase a la hoja3, etc.
Entonces utiliza la siguiente macro:
Dim celda ' Private Sub CommandButton1_Click() 'Por.Dante Amor Application.ScreenUpdating = False n = Sheets.Count m = ActiveSheet.Index TextBox1 = "": TextBox2 = "": TextBox3 = "": TextBox4 = "" For h = 1 To n On Error GoTo nohay If busqueda1.Enabled = False Then Cells.Find(What:=busqueda2, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False).Activate If celda <> ActiveCell.Address Then If celda = "" Then celda = ActiveCell.Address TextBox1 = ActiveCell.Offset(0, 1) TextBox2 = ActiveCell.Offset(0, 2) TextBox3 = ActiveCell.Offset(0, 3) TextBox4 = ActiveCell.Offset(0, 4) Exit For End If Else Cells.Find(What:=busqueda1, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False).Activate If celda <> ActiveCell.Address Then If celda = "" Then celda = ActiveCell.Address TextBox1 = ActiveCell.Offset(0, 2) TextBox2 = ActiveCell.Offset(0, 3) TextBox3 = ActiveCell.Offset(0, 4) TextBox4 = ActiveCell.Offset(0, 5) Exit For End If End If m = m + 1 If m > n Then m = 1 Sheets(m).Select celda = "" buscaotra = True nohay: On Error GoTo -1 If buscaotra = False Then m = m + 1 If m > n Then m = 1 Sheets(m).Select celda = "" End If buscaotra = False Next If TextBox1 = "" Then MsgBox "No se encuentra información con los datos suministrados, intente con datos distintos" End If End Sub
si quieres ver como va cambiando de hoja en hoja, entonces quita esta línea de la macro:
Application.ScreenUpdating = False
':) ':)
H o l a:
Tienes que agregar estos eventos a tu userform:
Private Sub busqueda1_Change() celda = "" End Sub Private Sub busqueda2_Change() celda = "" End Sub
Si ya tienes los eventos, solamente agrega la línea:
celda = ""
Revisa que al principio de todas las macro quede declarada la variable:
dim celda
Veo bien tu código pero no veo cuando activas los libros para la búsqueda en cada uno. Debes activar los libros para hacer referencia a ellos por que si no te buscara siempre en el mismo libro y te podría dar un desbordamiento.
Hoja1. Activate luego Hoja2. Activate y así hasta que completes la cantidad de hojas que tengas
Te escribo el código que tengo para buscar en todas las hojas y el cual no me arroja ningún resultado:
Private Sub CommandButton1_Click()
Dim Sh as WorkSheet
On Error GoTo nohay
For Each Sh In ActiveWorkbook.Sheets
Sh.Select
If busqueda1.Enabled = False Then
Cells.Find(What:=busqueda2, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 1).Select
TextBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox2 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox3 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox4 = ActiveCell
Else
Cells.Find(What:=busqueda1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 2).Select
TextBox1 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox2 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox3 = ActiveCell
ActiveCell.Offset(0, 1).Select
TextBox4 = ActiveCell
End If
If TextBox1 = "" Then
MsgBox "No se encuentra información con los datos suministrados, intente con datos distintos"
End If
Next Sh
nohay:
End Sub
Amigo el código lo veo bien, ahora dices que no te consigue nada, has un recorrido en frío paso a paso desde la primera hoja a ver si realmente no consigue nada por que cuando consigue no estoy viendo que el procedimiento se detenga sigue hasta el final y de igual manera si es de copiarlo y pasarlos o otro lugar solo lo seleccionas no haces mas nada y esos procesos son muy rápido, realiza eso a ver si no estoy equivocado
Amigo Chequea lo que te coloco Dante Amor creo que es la solución...