Macro en worksheet_change me permita borrar datos al eliminar contenido en 2 celdas
Tengo el siguiente código
Private Sub Worksheet_Change(ByVal Target As Range)
'Exit Sub
If Not Intersect(Target, Range("F5, D4")) Is Nothing Then
If UCase(Target.Value) <> "" Then
Set h = ThisWorkbook.Sheets(Hoja31.Name) 'base de datos
Set h2 = ThisWorkbook.Sheets(Hoja32.Name) 'reporte produccion
Dim ultfiladatos As Long
Dim ultfilareporte As Long
ultfiladatos = h.Range("a" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For cont = 2 To ultfiladatos
clave = h.Cells(cont, 6)
ref = h.Cells(cont, 1)
orden = h.Cells(cont, 5)
If ref = h2.[D4] & h2.[d5] & h2.[d6] Then
ultfilareporte = h2.Range("c" & Rows.Count).End(xlUp).Row
[F1] = "Este pedido ya cuenta con datos."
h2.Cells(ultfilareporte + 1, 3) = clave
h2.Cells(ultfilareporte + 1, 4) = orden
End If
Next cont
Application.ScreenUpdating = True
ElseIf UCase(Target.Value) = Empty Then
MsgBox "Borrar datos"
Range("D4:f4").ClearContents
End If
End If
End Sub
Me funciona bien, pero al llegar en la parte donde borro los datos
De la celda F5 o de la celda D4
Este le tengo puedo que me salga un mensaje de "borrar datos"
Y posterior a ello me borre los datos que le solicito, sin embargo me sale error
"no coinciden los tipos"
Alguien me puede ayudar con la adecuacion de mi macro
1 Respuesta
Mi vídeo sobre:
Consejos para desarrollar macros
Private Sub Worksheet_Change(ByVal Target As Range)
'Exit Sub
If Not Intersect(Target, Range("F5, D4")) Is Nothing Then
If UCase(Target.Value) <> "" Then
Set h = ThisWorkbook.Sheets(Hoja31.Name) 'base de datos
Set h2 = ThisWorkbook.Sheets(Hoja32.Name) 'reporte produccion
Dim ultfiladatos As Long
Dim ultfilareporte As Long
ultfiladatos = h.Range("a" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For cont = 2 To ultfiladatos
clave = h.Cells(cont, 6)
ref = h.Cells(cont, 1)
orden = h.Cells(cont, 5)
If ref = h2.[D4] & h2.[d5] & h2.[d6] Then
ultfilareporte = h2.Range("c" & Rows.Count).End(xlUp).Row
[F1] = "Este pedido ya cuenta con datos."
h2.Cells(ultfilareporte + 1, 3) = clave
h2.Cells(ultfilareporte + 1, 4) = orden
End If
Next cont
Application.ScreenUpdating = True
ElseIf UCase(Target.Value) = Empty Then
MsgBox "Borrar datos"
'se apagan los eventos para que no entre en un ciclo la macro
Application.EnableEvents = False
Range("D4").ClearContents
Range("F5").ClearContents
Application.EnableEvents = True
End If
End If
End Subsal u dos!!!
Hola dan
Me sale el error
No coinciden los tipos
En esta línea
If UCase(Target.Value) <> "" Then
esto me pasa
Esa parte ya estaba en tu código
If Not Intersect(Target, Range("F5, D4")) Is Nothing Then
If UCase(Target.Value) <> "" ThenTienes una celda combinada?
No es recomendable utilizar celdas combinadas...
no, no es una celda combinada
son 2 celdas independientes
lo que quisiera que haga es que
al tener datos una de esas celdas
haga la macro mencionada
y al borrar datos de una de las celdas mencionadas
borre los datos que tengo
pero no se esta bien hecha la macro
No estoy probando el código completo, solamente te estoy ayudando con el error que reportaste en tu post original:
"Me funciona bien, pero al llegar en la parte donde borro los datos"
Prueba esto:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5, D4")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target.Value <> "" Then
Set h = ThisWorkbook.Sheets(Hoja31.Name) 'base de datos
Set h2 = ThisWorkbook.Sheets(Hoja32.Name) 'reporte produccion
Dim ultfiladatos As Long
Dim ultfilareporte As Long
ultfiladatos = h.Range("a" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For cont = 2 To ultfiladatos
clave = h.Cells(cont, 6)
ref = h.Cells(cont, 1)
orden = h.Cells(cont, 5)
If ref = h2.[D4] & h2.[d5] & h2.[d6] Then
ultfilareporte = h2.Range("c" & Rows.Count).End(xlUp).Row
[F1] = "Este pedido ya cuenta con datos."
h2.Cells(ultfilareporte + 1, 3) = clave
h2.Cells(ultfilareporte + 1, 4) = orden
End If
Next cont
Application.ScreenUpdating = True
ElseIf UCase(Target.Value) = Empty Then
MsgBox "Borrar datos"
'se apagan los eventos para que no entre en un ciclo la macro
Application.EnableEvents = False
Range("D4").ClearContents
Range("F5").ClearContents
Application.EnableEvents = True
End If
End If
End Sub
