VBA Modificar formato de un Rango cuando cambia una celda
He hecho una macro para detectar un cambio de celda en un rango de una hoja y cambiar automaticamente el formato de la línea donde se produjo el cambio.
Si se selecciona "X" de una lista despegable en el rango "C15:C2000" se cambia el formato de toda la línea a itálica y font gris. Hasta aquí parece funcionar aunque me envía la celda seleccionada varias columnas a la izquierda (¿?) Pero es un bug menor. El problema es que deseo que al modificar dicho valor de la celda de "X" a su valor original de "P" o "U" la línea vuelva a su formato original (font xlAutomatic.)
¿Alguna sugerencia?
Gracias
---------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BuscarRango As String
BuscarRango = "C15:C2000"
Application.EnableEvents = False
On Error GoTo Error
If Not Application.Intersect(Target, Range(BuscarRango)) Is Nothing Then
Encontrarvalores
End If
Error:
Application.EnableEvents = True
End Sub
----------------
Public Sub Encontrarvalores()
Dim resultadoX, resultadoP, resultadoU As Range
Dim primerabusqueda As String
Dim Rango As String
Rango = "C15:C2000"
resultadoX = Range(Rango).Find("X")
If resultadoX Is Nothing Then
Else
primerabusqueda = resultadoX.Address
Do
ActiveCell.Offset(0, -2).Range("A1:R1").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
End With
Selection.Font.Italic = True
ActiveCell.Offset(0, 0).Select
ActiveCell.Offset(0, 13).Range("A1").Value = "Deleted by MMI"
'ActiveCell.Value = "Deleted by MMI"
resultadoX = Range(Rango).FindNext(resultadoX)
Loop While Not resultadoX Is Nothing And resultadoX.Address <> primerabusqueda
End If
'Set resultadoP = Range(Rango).Find("P")
'If resultadoP Is Nothing Then
'Else
'primerabusqueda = resultadoP.Address
' Do
' 'resultadoP.Select
' ActiveCell.Offset(0, -2).Range("A1:R1").Select
' With Selection.Font
' .ColorIndex = xlAutomatic
' .TintAndShade = -0
' End With
'Selection.Font.Italic = False
'ActiveCell.Offset(0, 13).Range("A1").Select
'ActiveCell.Value = "" 'Borrar la etiqueta "Deleted by MMI"
'resultadoP = Range(Rango).FindNext(resultadoP)
'Loop While Not resultadoP Is Nothing And resultado.Address <> primerabusqueda
'End If
'IDEM para resultadoU
End Sub