在单元格更改时执行excel VBA宏不会更新

Question

I have this code:

  Sub CheckRevision()
      Dim CurCell As Object
      For Each CurCell In ActiveWorkbook.ActiveSheet.Range("B1:B5000")
         If CurCell.Value = "Live" Then CurCell.Interior.Color = RGB(0, 204, 0)
      Next
   End Sub

   Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range("B1:B5000")) Is Nothing Then CheckRevision
End Sub

This works fine, however if I then have a cell which is "live" and change it back to "NOTLIVE" for example, the formatting is still a green cell. How do I get it to put it back to white default?

Answer 1

try: (but have a look art Peh's comment)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range("B1:B5000")) Is Nothing Then
    For Each cl In Intersect(Target, Me.Range("B1:B5000"))
        If UCase(cl.Value) = "LIVE" Then
        cl.Interior.Color = RGB(0, 204, 0)
        Else
        cl.Interior.Color = xlNone
        End If
    Next
    End If
End Sub

Answer 2

Just replace line If CurCell.Value = "Live" Then CurCell.Interior.Color = RGB(0, 204, 0)

with

If curcell.Value = "Live" Then
    curcell.Interior.Color = RGB(0, 204, 0)
Else
    curcell.Interior.Pattern = xlNone
End If

Answer 3

You don't really need the If statement at all.. you could just use this:

Sub CheckRevision()
   Dim CurCell As Object
   For Each CurCell In ActiveWorkbook.ActiveSheet.Range("B1:B5000")
      CurCell.Interior.Color = xlNone - ((CurCell.Value = "Live") * (RGB(0, 204, 0) - xlNone))
   Next
End Sub

---

So, how does this work? (Thanks, Pᴇʜ)

You're basically attempting to paint a cell with a colour that is either:

xlNone or RGB(0, 204, 0)

-4142 or 52224

This is decided by the CurCell.Value = "Live" which when used this way (cast into an integer) will return either 0 (for False ) or -1 (for True ).

Knowing that all this decision making results in a little bit of maths allows us to write an equation that causes the 0 or -1 to produce the two values:

If CurCell.Value = "Live" then the equation looks like this:

CurCell.Interior.Color

= xlNone - (-1 * (RGB(0, 204, 0) - xlNone))

... = xlNone - (-1 * (RGB(0, 204, 0) - xlNone))

... = RGB(0, 204, 0)

= 52224

If CurCell.Value <> "Live" then the equation looks like this:

CurCell.Interior.Color = xlNone - (0 * (RGB(0, 204, 0) - xlNone))

... = xlNone - (0 * (RGB(0, 204, 0) - xlNone))

... = xlNone

= -4142

Answer 4

if you aiming to change ONLY value of the cell you change the particular moment you can use the below which does not loop the whole range BUT test only the specific cell.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    'Check if the cell changed included in the range B1:B5000 & if only one cell changed to avoid errors
    If Not Intersect(Target, Range("B1:B5000")) Is Nothing And Target.Count = 1 Then
        'Call the module to apply formatting passing 3 parameters.
        Call Module1.CheckRevision(Target.Worksheet, Target.Value, Target.Address)
    End If

End Sub

---

Sub CheckRevision(wsName As Worksheet, cellValue As String, cellAddress As String)

    With wsName.Range(cellAddress)
        If cellValue = "Live" Then
            .Interior.Color = RGB(0, 204, 0)
        Else
            .Interior.Pattern = xlNone
        End If
    End With

End Sub