Eliminar una fila con un botón(macro) con dos criterios
Tengo una base de datos donde debo eliminar una fila que contiene unos datos específicos los cuales filtro por fecha y turno, requiero de un botón "eliminar" que me elimina dicha fila específicamente cuando coloco esos dos criterios en mis textbox. Ya cuento con el código de búsqueda donde me localiza la fila que quiero, pero cuando coloco la línea de código a eliminar no lo hace...
Adjunto el código
'Funciones del botón eliminar
Private Sub ELIMINAR_Click()
On Error Resume Next
If FECHA = Empty Then
MsgBox ("El campo fecha esta vacio"), vbCritical, "Advertencia"
FECHA.BackColor = &HFF&
ElseIf TURNO = Empty Then
MsgBox ("El campo turno esta vacio"), vbCritical, "Advertencia"
TURNO.BackColor = &HFF&
Exit Sub
End If
respuesta = MsgBox("¿Seguro desea eliminar los valores seleccionados?", vbCritical + vbYesNo, "Parametros")
dato = ""
Set h = Sheets("AGUA")
If respuesta = 6 Then
For i = 9 To h.Range("A" & Rows.Count).End(xlUp).Row
If h.Cells(i, "A") = FECHA And _
h.Cells(i, "D") = TURNO Then
dato = i
Exit For
End If
Next
If dato = "" Then
MsgBox ("No se elimino el registro"), vbExclamation, "Advertencia"
Else
dato.EntireRow.Delete
FECHA.BackColor = &HFFFFFF
TURNO.BackColor = &HFFFFFF
MsgBox ("Datos eliminados"), vbInformation, "Parametros"
End If
End If
End Sub
3 Respuestas
Para poner EntireRow, necesitas un objeto... dato es una simple variable... no hace alusión a una celda, sino a un valor...
Cambia:
dato.EntireRow.Delete
por
h.Cells(i, "A").EntireRow.Delete
Amigo! No me funciono el botón no hace nada, si me consigue el dato más no elimina la fila de la base de datos, por lo que veo no evalúa el condicional IF
¿Que puedo hacer para arreglar el código que tengo amigo?
Si lo que no funciona es el criterio de comparación hagamos dos cosas:
1) En la primera línea del módulo, antes de la macro escribe
Option Compare Text
Esta opción permite que VBA no diferencia maýusculas de minúsculas... (no se si tu turno son números o letras)
2) Crea temporalmente un código para forzar que encuentre algo y ver que cosa no funciona... agrega un botón prueba, e introduce en tu formularios los datos veas en la línea 9 (celdas A9 y D9) de tu hoja "AGUA"... forzamos a que "encuentre" los valores en la primera línea... Los encuentre o no, igual mostramos que valore está comparando VBA
Comenta luego, que mostraron los Msgbox:
Private Sub PRUEBA_Click()
Set h = Sheets("AGUA")
For i = 9 To 9
If h.Cells(i, "A") = FECHA And h.Cells(i, "D") = TURNO Then
Msgbox "Lo encontre en la fila " & i
Else
Msgbox "NO LO ENCONTRE en la fila " & i
End if
Mgsbox "Valor en celda " & h.Cells(i,"A") & vbtab & "Valor en TB " & FECHA
Mgsbox "Valor en celda " & h.Cells(i,"D") & vbtab & "Valor en TB " & TURNO
Next i
End Sub
¡Gracias!
Funciono perfectamente... :-) ahora si quisiera con un botón "actualizar" buscar el dato corregir un valor el guardarlo nuevamente en su respectiva fila???
No entiendo bien que cosa fue lo funcionó si el codigo original o la propuesta para ver si encontraba el dato en la fila 9... espero que sea el original
La pregunta nueva que haces es... ¿buscar segun los criterios y actualizar a nuevos valores?
La clave es tu variable "dato"
Una vez que encuentras el valor buscado, copia esos valores hacia los textbox del formulario... uno a uno
Mira:
If h.Cells(i, "A") = FECHA Then ..... esta compara si ambos valores son iguales...
If FECHA = h.Cells(i, "A") Then ..... tambien compara si ambos valores son iguales... (el orden en una comparacion no interesa)... pero
Para leer tienes que programar (en otro botón) una macro, similar a la de borrar pero que una vez encontrado el valor ejecuta varias instrucciones de este tipo:
FECHA= h.Cells(dato, "A") lleva el valor de la celda al text box... tb<===celda
(Asi tienes que leer)
Para escribir, una vez hallado el dato, y modificado, tienes que ejecutar varias instrucciones de este tipo, que deberían estar programadas en otro botón:
h.Cells(dato, "A") = FECHA lleva el valor del textbox a la celda celda<====tb
Para que la variable "dato" este disponible en todos los procedimientos y el valor se mantenga y comparta, coloca Private dim al inicio del módulo (antes de las macros)
Trata con esta macro, en tu código falta relacionar las variables con los textbox, después de la pantalla con los resultados de la macro esta el código
este es el codigo
Private Sub ELIMINAR_Click()
Set h = Worksheets("AGUA")
On Error Resume Next
nfecha = CDate(fecha.Text): Nturno = LCase(turno.Text)
On Error GoTo 0
If nfecha = Empty Then
MsgBox ("El campo fecha esta vacio"), vbCritical, "Advertencia"
fecha.BackColor = &HFF&
End If
If Nturno = Empty Then
MsgBox ("El campo turno esta vacio"), vbCritical, "Advertencia"
turno.BackColor = &HFF&
End If
cuenta = WorksheetFunction.CountIf(Columns(1), nfecha)
If cuenta = 0 Then MsgBox ("LA FECHA NO EXISTE"), vbCritical, "AVISO": GoTo salida
For i = 1 To cuenta
If i = 1 Then Set busca = h.Columns(1).Find(nfecha)
If i > 1 Then Set busca = h.Columns(1).FindNext(busca)
n = Range(busca.Address).Row: shift = LCase(Cells(n, 4))
If shift = Nturno Then FILA = Cells(n, 4).Row: Exit For
Next
If FILA = Empty Then MsgBox ("NO EXISTE EL TURNO"), vbCritical, "AVISO": GoTo salida
h.Rows(FILA).Select:
ASK = MsgBox("BORRAR REGISTRO?", vbYesNo, "AVISO")
If ASK = 6 Then h.Rows(FILA).EntireRow.Delete
salida:
End Sub
