Geek asks and answers

A macro is needed to determine if a cell value is changing from its current value.

I need help with a macro to notify me (changing the background color of the cell to red) when the value (always the number format) changes in any cells in the row. I want the background of cell E3 to change to red if any of the values ​​in cells F3: AN3 change from their current values.

The numbers in cells F3: AN3 will be entered manually or through copy and paste of the line, and there will be no formulas. Similarly, if any values ​​in cells F4: AN4 are changed, I would like cell E4 to change to a red background and so on for each of the lines in the diagram. Not all lines will always matter, so I would look for changes from "to any # or from one # to another # or from any # to" ". Ideally, this would be an event macro that does not need to be triggered manually.

Below is the code I started working with:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub


Private Sub KeyCellsChanged()

   Dim Cell As Object
     For Each Cell In Range("E3")
    Cell.Interior.ColorIndex = 3

   Next Cell

End Sub

However, this macro seems to work regardless of whether the number in the cell changes, while I press the enter button, it highlights E3 as red.

Any help is much appreciated!

+3
source share
2 answers

. . , .

Option Explicit

Dim PrevVal As Variant

Private Sub Worksheet_Activate()
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo ExitGraceFully
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
ExitGraceFully:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub

    Dim aCell As Range, i As Long, j As Long

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
        If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
            Range("E" & Target.Row).Interior.ColorIndex = 3
        ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
            i = 1
            For Each aCell In Target
                If aCell.Value <> PrevVal(i, 1) Then
                    Range("E" & aCell.Row).Interior.ColorIndex = 3
                End If
                i = i + 1
            Next
        ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
            Dim pRow As Long

            i = 1: j = 1

            pRow = Target.Cells(1, 1).Row

            For Each aCell In Target
                If aCell.Row <> pRow Then
                    i = i + 1: pRow = aCell.Row
                    j = 1
                End If

                If aCell.Value <> PrevVal(i, j) Then
                    Range("E" & aCell.Row).Interior.ColorIndex = 3
                End If
                j = j + 1
            Next
        End If
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    Resume LetsContinue
End Sub

SNAPSHOTS

. . , 1 . , ( )

enter image description here

. .

+3

Excel VBA:

  • , , .
  • ( ) , if, 1, , 0.
  • , , ( ) > 0.

:

+2

More articles:


All Articles