admin管理员组文章数量:1391918
Coding in Microsoft Excel, VBA.
I have no coding experience, so I was trying to leverage GPT in assisting me in my code, problem is: I can't diagnose the issue.
I am trying to write VBA code, that updates the current value in the cell, rather than replacing it. What I mean by this is: say in cell G2, the existing value is 2, I want to be able to type in 1, and the value be updated to 3, rather than replaced to 1.
I am hoping I can do this for a range of cells, maybe a whole column, or multiple columns.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
' Check if the change is in the specified ranges (G2:G1000, H2:H1000, I2:I1000, J2:J1000)
If Not Intersect(Target, Me.Range("G2:G1000,H2:H1000,I2:I1000,J2:J1000")) Is Nothing Then
' Disable events to avoid a loop (we'll re-enable after the update)
Application.EnableEvents = False
' Loop through each cell that was changed
For Each cell In Target
If IsNumeric(cell.Value) Then
' If the cell already has a value, add the new value to it
If cell.Value <> "" Then
cell.Value = cell.Value + cell.OldValue ' Adds the old value to the new value
End If
End If
Next cell
' Re-enable events
Application.EnableEvents = True
End If
End Sub
Please let me know if what I am looking for is possible, and how I can fix this code to achieve that.
Thanks
Coding in Microsoft Excel, VBA.
I have no coding experience, so I was trying to leverage GPT in assisting me in my code, problem is: I can't diagnose the issue.
I am trying to write VBA code, that updates the current value in the cell, rather than replacing it. What I mean by this is: say in cell G2, the existing value is 2, I want to be able to type in 1, and the value be updated to 3, rather than replaced to 1.
I am hoping I can do this for a range of cells, maybe a whole column, or multiple columns.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
' Check if the change is in the specified ranges (G2:G1000, H2:H1000, I2:I1000, J2:J1000)
If Not Intersect(Target, Me.Range("G2:G1000,H2:H1000,I2:I1000,J2:J1000")) Is Nothing Then
' Disable events to avoid a loop (we'll re-enable after the update)
Application.EnableEvents = False
' Loop through each cell that was changed
For Each cell In Target
If IsNumeric(cell.Value) Then
' If the cell already has a value, add the new value to it
If cell.Value <> "" Then
cell.Value = cell.Value + cell.OldValue ' Adds the old value to the new value
End If
End If
Next cell
' Re-enable events
Application.EnableEvents = True
End If
End Sub
Please let me know if what I am looking for is possible, and how I can fix this code to achieve that.
Thanks
Share Improve this question asked Mar 11 at 19:01 DoggySlayerDoggySlayer 91 bronze badge1 Answer
Reset to default 0Sure, you just need to use to different event types to capture the value of the cell before it's changed and after it's changed.
Dim oldValue As Double ' Variable to store the old value before change
' Capture the old value before a change occurs
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Me.Range("G:G")) Is Nothing Then ' Change "G:G" to your desired column(s)
If IsNumeric(Target.Value) Then
oldValue = Target.Value
Else
oldValue = 0 ' Default to 0 if the cell is empty or contains text
End If
End If
End Sub
' Update the cell with the sum of old value and new value
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newValue As Double
If Not Intersect(Target, Me.Range("G:G")) Is Nothing Then ' Change "G:G" to desired range
Application.EnableEvents = False ' Prevent infinite loops
If IsNumeric(Target.Value) Then
newValue = Target.Value
Target.Value = oldValue + newValue ' Add old and new values together
End If
Application.EnableEvents = True ' Re-enable events
End If
End Sub
本文标签:
版权声明:本文标题:Is there a way to setup VBA code in excel so that when I input a value into an existing cell, it stacks and adds on rather than 内容由网友自发贡献,该文观点仅代表作者本人, 转载请联系作者并注明出处:http://www.betaflare.com/web/1744775607a2624604.html, 本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容,一经查实,本站将立刻删除。
发表评论