VBA to add cell contents to another cell

[samcdavies]

Hi all

I have data in column T (always numerical) between row 1 and 10,000 - everytime the number is changed, I'd like the number to be added to column CK.

So for example T1 is changed to 40, cell CK1 is now 40.
Then T1 is changed to 50, so CK1 is now 90.
Then T1 changed to zero so CK1 remains at 90
Then T1 is changed to 100 so CK1 becomes 190
...and so on forever....

Is this possible?

Thanks very much in advance!

[ragulduy]

in the worksheet object:

Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Range("T:T")) Is Nothing Then
    Range("CK" & target.Row) = Range("CK" & target.Row) + target
End If
End Sub

[samcdavies]

in the worksheet object:
....

Thanks for the quick reply, this worked once, but wouldn't work again. Any ideas?

[ragulduy]

Nope. Do you have more code in your workbook, if it worked once then I can only think maybe enableevents has been set to false?

I might be able to give a better answer if you post a workbook.

[samcdavies]

Nope. Do you h.....

There is more code; here you go;

Private Sub Worksheet_Activate()
Application.Run Database!CalcMostRecentBooking
End Sub


Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Range("T:T")) Is Nothing Then
Range("CK" & target.Row) = Range("CK" & target.Row) + target
End If

Dim lngCol As Long


If target.Column > 1 And target.Column < 7 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
With Cells(target.Row, Column + 95)
.Value = Environ("Username") & " " & Now
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End With
Application.EnableEvents = True
End If

If target.Column > 17 And target.Column < 24 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
With Cells(target.Row, Column + 96)
.Value = Environ("Username") & " " & Now
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End With
Application.EnableEvents = True
End If

If target.Column > 30 And target.Column < 38 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
With Cells(target.Row, Column + 97)
.Value = Environ("Username") & " " & Now
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End With
Application.EnableEvents = True
End If

If target.Column > 43 And target.Column < 51 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
With Cells(target.Row, Column + 98)
.Value = Environ("Username") & " " & Now
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End With
Application.EnableEvents = True
End If

If target.Column > 56 And target.Column < 64 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
With Cells(target.Row, Column + 99)
.Value = Environ("Username") & " " & Now
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End With
Application.EnableEvents = True
End If

If target.Column > 69 And target.Column < 77 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
With Cells(target.Row, Column + 100)
.Value = Environ("Username") & " " & Now
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End With
Application.EnableEvents = True
End If
End Sub

I might have put it in the wrong place?

[ragulduy]

no it is fine in that place. I'd guess you had an error or something and enableevents got set to false. Try running a macro like:

sub macro_1()
application.enableevents = true
end sub

and then see if it starts working again

[samcdavies]

no it is fine in that place. I'd guess you had an error or something and enableevents got set to false. Try running a macro like:

I've figured out what was wrong - that cell is protected, so protection was getting in the way. I've rectified it now by adding a remove protection/reactivate protection code to it.

Thanks very much!

[ragulduy]

In a blank macro, put it wherever. Just need to run it once then delete it. Alternatively close excel completely then open it again and see if it works.