Updating cell value due to manual change in another cell only once
I want to increase C49 by 0.8 if some change happens in C50. But I only want this to be done once. I am using the following code but the increment continues
Private Sub Worksheet_Change(ByVal Target As Range)
dim x as Integer
x=0
If Not Intersect(Target, Range("C50")) Is Nothing Then
If Not IsEmpty(Cells(49, 3).Value) Then
If x = 0 Then
Cells(49, 3).Value = Cells(49, 3).Value + 0.8
x = x+1
End If
End If
End If
End Sub
+3
source to share
2 answers
Try using the following VBA code:
Dim PerformChange As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If PerformChange Then
If Not ((Intersect(Target, Range("C50")) Is Nothing) Or _
(IsEmpty(Cells(49, 3).Value))) Then
PerformChange = False
Cells(49, 3).Value = Cells(49, 3).Value + 0.8
End If
Else
PerformChange = True
End If
End Sub
The global boolean is PerformChange
used to allow only one change, otherwise the procedure Change
is called recursively.
0
source to share
Here's one way to do it. I also disabled / enabled events and added error handling. You might want to see THIS
Logic:
The first time he writes in C49, name the cell like DoNoWriteAgain
. Next time, just check if the cell was named and if it didn't add;)
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sName As String
Dim rRangeCheck As Range
On Error GoTo Whoa
Application.EnableEvents = False
sName = "DoNoWriteAgain"
On Error Resume Next
Set rRangeCheck = Range(sName)
On Error GoTo 0
If rRangeCheck Is Nothing Then
If Not Intersect(Target, Range("C50")) Is Nothing Then
If Not IsEmpty(Cells(49, 3).Value) Then
Cells(49, 3).Value = Cells(49, 3).Value + 0.8
ActiveWorkbook.Names.Add Name:=sName, _
RefersToR1C1:="=" & ActiveSheet.Name & "!R49C3"
End If
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
0
source to share