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 badge
Add a comment  | 

1 Answer 1

Reset to default 0

Sure, 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

本文标签: