简体   繁体   中英

VBA save value from cell before it changes

I have a spreadsheet where i implement a score board. The behavior i need is when the cell that has the score value rises the cell near it, on column b, changes it's color to green, when the the cell score value goes down the cell near it changes it's color to red.

The cell range where the score is changing is e5:e67

In short: When the user inputs a number in column f, the score raises in column e, and in column b (on same row) the color must change to green or red

I made this VBA code, but without luck.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("e5:e67")) Is Nothing Then
 If Target.Column = 5 Then
  thisRow = Target.Row
  Dim OldValue As Variant
  Application.EnableEvents = False
  Application.Undo
  OldValue = Target.Value
  Application.Undo
  Application.EnableEvents = True
 If OldValue < Target.Value Then
  Range("b" & thisRow).Interior.ColorIndex = 4
 ElseIf OldValue > Target.Value Then
  Range("b" & thisRow).Interior.ColorIndex = 3
 End If
 End If
End If
End Sub

Here is a screen capture of my ranking sheet: 在此处输入图片说明

Try by intercepting the Worksheet_Calculate event. You need to save the old value in a static local array, that I call oldVal .

Private Sub Worksheet_Calculate()
  Static oldVal
  If IsEmpty(oldVal) Then
    oldVal = Application.Transpose(Range("e5:e67").Value2)
    ReDim Preserve oldVal(5 To 67)
    Exit Sub
  End If
  Dim i As Long
  For i = LBound(oldVal) To UBound(oldVal)
    If oldVal(i) > Cells(i, "E").Value2 Then Cells(i, "B").Interior.ColorIndex = 3
    If oldVal(i) < Cells(i, "E").Value2 Then Cells(i, "B").Interior.ColorIndex = 4
    oldVal(i) = Cells(i, "E").Value2
  Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
 If Not Intersect(Target, Range("e6:e67")) Is Nothing Then
    If Target.Offset(-1) < Target Then
        i = 4
    Else
        i = 3
    End If
    Range("b" & Target.Row).Interior.ColorIndex = i
End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM