Modify VB for a Runnning Total

M

mytibt

Good Morning,

I'm new to the board and look forward to exchanging ideas with all of
you. I found the following script off of a Microsoft tutorial for
creating a running total on Excel. My problem with it, is asked after
the script, below. Thanks in advance for reading:


Code:
--------------------

' The Auto_Open name forces this macro to run every time
' the workbook containing this macro is opened.

Sub Auto_Open()
' Every time a cell's value is changed,
' the RunningTotal macro runs.
Application.OnEntry = "RunningTotal"
End Sub

'----------------------------------------------------------
' This macro runs each time the value of a cell changes.
' It adds the current value of the cell to the value of the
' cell comment. Then it stores the new total in the cell comment.
Sub RunningTotal()

On Error GoTo errorhandler ' Skip cells that have no comment.

With Application.Caller

' Checks to see if the cell is a running total by
' checking to see if the first 4 characters of the cell
' comment are "RT= ". NOTE: there is a space after the equal
' sign.
If Left(.Comment.Text, 4) = "RT= " Then

' Change the cell's value to the new value in the cell
' plus the old total stored in the cell comment.
RT = .Value + Right(.Comment.Text, Len(.Comment.Text) - 4)
.Value = RT

' Store the new total in the cell note.
.Comment.Text Text:="RT= " & RT


End If
End With

Exit Sub ' Skip over the errorhandler routine.

errorhandler: ' End the procedure if no comment in the cell.
Exit Sub

End Sub

'--------------------------------------------------------------
' This macro sets up a cell to be a running total cell.
Sub SetComment()
With ActiveCell
' Set comment to indicate that a running total is present.
' If the ActiveCell is empty, multiplying by 1 will
' return a 0.
.AddComment
.Comment.Text Text:="RT= " & (ActiveCell * 1)
End With
End Sub
--------------------




This code allows me to add to the running total by entering the
numerical value in the cell containing the comment. However, say I have
Cell A1 and B1 involved. I want to modify the script in a way that I can
enter the value in A1, and have B1 keeping a cumulative running total.
Cell A1 is labeled as "currentweek" and cell B1 is labeled as
"weektodate" Any help is appreciated and thank you again.

Robert
 
B

Bob Phillips

A different approach. Remove the other code you have and try this

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
If Target.Address = "$A$1" Then
With Target
If .Count = 1 Then
If IsNumeric(.Value) Then
.Offset(0, 1).Value = .Offset(0, 1).Value + .Value
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top