Dudas sobre como colorear la celda anterior a la celda que almacena el nuevo dato
publicado
Hola!!
Conformo que soy nueva en esto de macros. He hecho un formulario investigando aqui y alla, el cual agrega y modifica datos y los almacena en otra hoja
del mismo libro.
Hasta ahi mi formulario funciona como lo deseo, pero al querer modificar o agregar un dato faltante aun registrom quiero que la celda anterior a la celda a la cual agrego el nuevo dato,
cambie el color de fondo.
Investigando di con el evento worksheet_change(ByVal Target As range)
el caso es que si hace el cambio de color de fondo, pero no queda permanente.
Dejo el codigo que use y les suplico ayuda
rivate Sub Worksheet_Change(ByVal Target As Range)
'Application.EnableEvents = False
'On Error GoTo Error
Dim c As Range
If Not Application.Intersect(Target, Range("I5:I400")) Is Nothing Then
For Each c In Range("H5:H400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
' Else
' c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("J5:J400")) Is Nothing Then
For Each c In Range("I5:I400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
'Else
'c.Interior.ColorIndex = xlColorIndexNone
' c.EntireRow.Hidden = True
' ElseIf c.Value = "#show#" Then
'c.EntireRow.Hidden = False
End If
Next
End If
If Not Application.Intersect(Target, Range("K5:K400")) Is Nothing Then
For Each c In Range("J5:J400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("L5:L400")) Is Nothing Then
For Each c In Range("K5:K400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("M5:M400")) Is Nothing Then
For Each c In Range("L5:L400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("N5:N400")) Is Nothing Then
For Each c In Range("M5:M400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("P5:P400")) Is Nothing Then
For Each c In Range("N5:N400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
'If Not Application.Intersect(Target, Range("P5:P400")) Is Nothing Then
'For Each c In Range("P5:P400")
' If Range.Value = Date Then
' Range.Interior.ColorIndex = 35
' Else
' c.Interior.ColorIndex = xlColorIndexNone
' End If
' Next
'End If
'Error:
'Application.EnableEvents = True
End Sub
'If .Range("I5").Value = DateValue(Date) Then
'.Range("H5").Interior.ColorIndex = 40
' Else
' .Range("H5").Interior.ColorIndex = xlNone
' End If
' If .Range("J5").Value = Date Then
' Sheets("Record").Range("I5").Interior.ColorIndex = 40
' Else
' .Range("I5").Interior.ColorIndex = xlNone
' End If
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Hola!!
Conformo que soy nueva en esto de macros. He hecho un formulario investigando aqui y alla, el cual agrega y modifica datos y los almacena en otra hoja
del mismo libro.
Hasta ahi mi formulario funciona como lo deseo, pero al querer modificar o agregar un dato faltante aun registrom quiero que la celda anterior a la celda a la cual agrego el nuevo dato,
cambie el color de fondo.
Investigando di con el evento worksheet_change(ByVal Target As range)
el caso es que si hace el cambio de color de fondo, pero no queda permanente.
Dejo el codigo que use y les suplico ayuda
rivate Sub Worksheet_Change(ByVal Target As Range)
'Application.EnableEvents = False
'On Error GoTo Error
Dim c As Range
If Not Application.Intersect(Target, Range("I5:I400")) Is Nothing Then
For Each c In Range("H5:H400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
' Else
' c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("J5:J400")) Is Nothing Then
For Each c In Range("I5:I400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
'Else
'c.Interior.ColorIndex = xlColorIndexNone
' c.EntireRow.Hidden = True
' ElseIf c.Value = "#show#" Then
'c.EntireRow.Hidden = False
End If
Next
End If
If Not Application.Intersect(Target, Range("K5:K400")) Is Nothing Then
For Each c In Range("J5:J400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("L5:L400")) Is Nothing Then
For Each c In Range("K5:K400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("M5:M400")) Is Nothing Then
For Each c In Range("L5:L400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("N5:N400")) Is Nothing Then
For Each c In Range("M5:M400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
If Not Application.Intersect(Target, Range("P5:P400")) Is Nothing Then
For Each c In Range("N5:N400")
If c.Value = Date Then
c.Interior.ColorIndex = 40
Else
c.Interior.ColorIndex = xlColorIndexNone
End If
Next
End If
'If Not Application.Intersect(Target, Range("P5:P400")) Is Nothing Then
'For Each c In Range("P5:P400")
' If Range.Value = Date Then
' Range.Interior.ColorIndex = 35
' Else
' c.Interior.ColorIndex = xlColorIndexNone
' End If
' Next
'End If
'Error:
'Application.EnableEvents = True
End Sub
'If .Range("I5").Value = DateValue(Date) Then
'.Range("H5").Interior.ColorIndex = 40
' Else
' .Range("H5").Interior.ColorIndex = xlNone
' End If
' If .Range("J5").Value = Date Then
' Sheets("Record").Range("I5").Interior.ColorIndex = 40
' Else
' .Range("I5").Interior.ColorIndex = xlNone
' End If