Adding an accumulator for multiple cells

[jrambo63]

From this group I learned to add a single cell accumulator using the
code on http://www.mcgimpsey.com/excel­/accumulator.html

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static dAccumulator As Double
With Target
If .Address(False, False) = "A1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
dAccumulator = dAccumulator + .Value
Else
dAccumulator = 0
End If
Application.EnableEvents = False
.Value = dAccumulator
Application.EnableEvents = True
End If
End With
End Sub


I was able to get it working for the cell I needed "C8" instead of
"A1", but I would like it running on multiple cells (all running an
accumulator). What do I need to change in the code to accomplish this?

The cells I need this for are C8 through O8 & C9 through O9

Thanks!

 

[JE McGimpsey]

Change

With Target
If .Address(False, False) = "A1" Then


to

With Target
If Not Intersect(.Cells, Range("C8:O9")) Is Nothing Then

 

[jrambo63]

Thanks JE for responding. I changed the code like you suggested, and
now I have the accumulator in all the fields. The thing now is that it
is accumulating for all the cells as one.

Example being when I enter the number 5 into cell C8 and then enter
another 5 into cell C8 then the new value is 10, then when I enter a
value of 2 into C9 then the new value for C9 becomes 12 instead of 2.

What I need is for each cell accumulator to be independent from the
others and only add what I enter for each particular cell. I apologize
for not being clearer in my original post.

 

[JE McGimpsey]

Whoops - didn't check out which result you really wanted. Try this.


Put this in the ThisWorkbook code module to load the range when the
workbook is opened:

Private Sub Workbook_Open()
Accum Source:=Sheets("Sheet1").Range("C8:O9")
End Sub

Put this in the Sheet1 (modify above to suit) code module:

Private Sub Worksheet_Change(ByVal Changed As Excel.Range)
Accum Target:=Changed
End Sub

Put this in a regular code module:

Public Sub Accum(Optional Target As Range, Optional Source As Range)
Static rSource As Range
Static vAccumulators As Variant
Static nRow As Long
Static nCol As Long

If Not Source Is Nothing Then
With Source
Set rSource = .Cells
nRow = .Item(1).Row - 1
nCol = .Item(1).Column - 1
vAccumulators = .Value
End With
End If
If Not rSource Is Nothing Then
If Target Is Nothing Then Exit Sub 'nothing to add
If Not Intersect(Target, rSource) Is Nothing Then
With Target(1)
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
vAccumulators(.Row - nRow, .Column - nCol) = _
vAccumulators(.Row - nRow, .Column - nCol) + .Value
Else
vAccumulators(.Row - nRow, .Column - nCol) = 0
End If
Application.EnableEvents = False
rSource.Value = vAccumulators
Application.EnableEvents = True
End With
End If
End If
End Sub

Save the file, close it and reopen it.

The first call (Workbook_Open in the ThisWorkbook module, which fires
when the workbook is opened) sets the source - you can reset the source
at any time by calling accum with the Source argument.

After that, any changes in the Source range will be accumulated.