SPANISH:
Estimados, uso Google Traductor porque mi inglés es muy básico.
He creado una macro que detecta cambios de valores en un rango de celdas y le cambia el color de fondo a la celda cambiada y 6 celdas a su izquierda, de color verde si se ingresa una fecha de egreso y de color blanco si se borra una fecha existente.
En mi proyecto de una base de datos de empleados, si se pone una fecha de egreso en la columna G (rango G5:G495) o se elimina una existente, se producen los cambios.
La macro funciona bien pero tiene algunas limitaciones que deseo resolver:
1) Al ingresar la fecha de egreso hay que pulsar la tecla enter o la flecha del teclado abajo, porque si se lo hace de otra manera (ejemplo la tecla tabulador) el rango de celdas a pintar no se respeta ya que el código toma la celda activa para efectuar los cambios.
2) El código funciona si los cambios se hacen de a una celda a la vez, si selecciono un rango de celdas para cambiar sus valores simultaneamente da error ("No coinciden los tipos".
¿Es posible solucionar estás 2 limitaciones o al menos la 2da.?
CODIGO:
CAPTURA DE PANTALLA CAMBIANDO VALOR A UNA CELDA:
ERROR SI INTENTO CAMBIAR VARIAS CELDAS A LA VEZ:
Adjunto archivo de Excel Microsoft 365: Descargar
Muchas gracias por la ayuda que me puedan brindar.
=====================================================
ENGLISH:
Dear, I use Google Translate because my English is very basic.
I have created a macro that detects changes in values in a range of cells and changes the background color of the changed cell and 6 cells to its left, green if an exit date is entered and white if one is deleted existing date.
In my project of an employee database, if a discharge date is put in column G (range G5: G495) or an existing one is deleted, the changes take place.
The macro works fine but it has some limitations that I want to solve:
1) When entering the exit date, you have to press the enter key or the down arrow of the keyboard, because if you do it in another way (example the tabulator key) the range of cells to be painted is not respected since the code takes the active cell to make changes.
2) The code works if the changes are made one cell at a time, if I select a range of cells to change their values simultaneously it gives an error ("The types do not match".
Is it possible to solve these 2 limitations or at least the 2nd one?
CODE:
Estimados, uso Google Traductor porque mi inglés es muy básico.
He creado una macro que detecta cambios de valores en un rango de celdas y le cambia el color de fondo a la celda cambiada y 6 celdas a su izquierda, de color verde si se ingresa una fecha de egreso y de color blanco si se borra una fecha existente.
En mi proyecto de una base de datos de empleados, si se pone una fecha de egreso en la columna G (rango G5:G495) o se elimina una existente, se producen los cambios.
La macro funciona bien pero tiene algunas limitaciones que deseo resolver:
1) Al ingresar la fecha de egreso hay que pulsar la tecla enter o la flecha del teclado abajo, porque si se lo hace de otra manera (ejemplo la tecla tabulador) el rango de celdas a pintar no se respeta ya que el código toma la celda activa para efectuar los cambios.
2) El código funciona si los cambios se hacen de a una celda a la vez, si selecciono un rango de celdas para cambiar sus valores simultaneamente da error ("No coinciden los tipos".
¿Es posible solucionar estás 2 limitaciones o al menos la 2da.?
CODIGO:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Comenté las 2 líneas siguientes para que vean las LIMITACIONES
'Application.EnableEvents = False
'On Error GoTo Error
Dim KeyCells As Range
' La variable KeyCells contiene el rango
' de las celdas que se controlará su cambio.
' para este caso he creado un nombre de rango para G5:G495
'que corresponde a la columna de Fecha de Egreso
Set KeyCells = Range("FechaEgreso")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
'Si el cambio en una de las celdas contiene un valor
'es distinto que vacio le pondrá color de relleno verde
If Range(Target.Address).Value <> "" Then
'pintará la celda cambiada y 6 celdas hacia su izquierda
'a la celda cambiada le pongo -1 porque al ingresar un valor
'y dar enter la celda activa es la de abajo de esa (LIMITACION)
Range(ActiveCell.Offset(-1, 0), ActiveCell.Offset(-1, -6)).Select
'elige un color verde para el rango a pintar
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65280
End With
'luego de pintar posiciona el cursor
'una celda + abajo que la cambiada
ActiveCell.Offset(1, 6).Select
End If
'si el cambio en la celda fue borrar un valor
If Range(Target.Address).Value = "" Then
'remueve el color verde de todo el rango
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, -6)).Select
'eligiendo un color de relleno blanco
With Selection.Interior
.ColorIndex = 0
End With
'luego de revertir el color de relleno a blanco
'posiciona el cursor en la misma celda que se
'borró el valor
ActiveCell.Offset(0, 6).Select
End If
End If
'Comenté las 2 líneas siguientes para que vean las LIMITACIONES
'Error:
'Application.EnableEvents = True
End SubCAPTURA DE PANTALLA CAMBIANDO VALOR A UNA CELDA:
ERROR SI INTENTO CAMBIAR VARIAS CELDAS A LA VEZ:
Adjunto archivo de Excel Microsoft 365: Descargar
Muchas gracias por la ayuda que me puedan brindar.
=====================================================
ENGLISH:
Dear, I use Google Translate because my English is very basic.
I have created a macro that detects changes in values in a range of cells and changes the background color of the changed cell and 6 cells to its left, green if an exit date is entered and white if one is deleted existing date.
In my project of an employee database, if a discharge date is put in column G (range G5: G495) or an existing one is deleted, the changes take place.
The macro works fine but it has some limitations that I want to solve:
1) When entering the exit date, you have to press the enter key or the down arrow of the keyboard, because if you do it in another way (example the tabulator key) the range of cells to be painted is not respected since the code takes the active cell to make changes.
2) The code works if the changes are made one cell at a time, if I select a range of cells to change their values simultaneously it gives an error ("The types do not match".
Is it possible to solve these 2 limitations or at least the 2nd one?
CODE:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'I commented the next 2 lines to see the LIMITATIONS
'Application.EnableEvents = False
'On Error GoTo Error
Dim KeyCells As Range
' The KeyCells variable contains the range
' of the cells that will be controlled its change.
' for this case I have created a range name for G5:G495
'which corresponds to the discharge Date column
Set KeyCells = Range("FechaEgreso")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
'If the change in one of the cells contains a value
'it is different that empty will put green fill color
If Range(Target.Address).Value <> "" Then
'It will paint the changed cell and 6 cells to its left
'I put -1 to the changed cell because when entering a value
'and I press the enter key, the active cell is the one below that (LIMITATION)
Range(ActiveCell.Offset(-1, 0), ActiveCell.Offset(-1, -6)).Select
'choose a green color for the range to be painted
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65280
End With
'after painting position the cursor
'a cell + below that changed
ActiveCell.Offset(1, 6).Select
End If
'if the change in the cell was delete a value
If Range(Target.Address).Value = "" Then
'removes the green color from the entire range
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, -6)).Select
'choosing a white fill color
With Selection.Interior
.ColorIndex = 0
End With
'after reverting the fill color to white
'positions the cursor in the same cell that the value was deleted
ActiveCell.Offset(0, 6).Select
End If
End If
'I commented the next 2 lines to see the LIMITATIONS
'Error:
'Application.EnableEvents = True
End Sub
