Rolling Total

  • Thread starter Thread starter terilad
  • Start date Start date
T

terilad

Hello,

I have a range of cells for input of hours 8 or 12, these total up in a cell
D1, is there a way of keeping this rolling total in this cell when I delete
the hours I input, so if I input hours 12 into A1, A2, A3 the total in cell
D1 should be 36, when I delete the hours in cells A1, A2 and A3 I want the 36
still to remain in cell D1 and again start totalling when I add further hours
to cell A1, A2, A3 and so on so it stays as a rolling total all the time.

Any help would be much appreciated.

Many thanks


Mark
 
You would need to add something like the following code to the module of the
worksheet you are working in. It will add whatever you type into A1:A3 to D1.

HTH,

Eric

*****
Paste the code below into the worksheet's code module:
*****
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, j As Long
Dim nAreas As Long
Dim theCell As Range
'
nAreas = Target.Areas.Count
'
' Since "Target" can have multiple areas selected, we
' need to check each cell in each area to see if it is
' in the range "A1:A3".
'
For i = 1 To nAreas
For Each theCell In Target.Areas(i).Cells
If (Not Intersect(theCell, ActiveSheet.Range("A1:A3")) Is
Nothing) Then
ActiveSheet.Range("D1") = ActiveSheet.Range("D1") + theCell
End If
Next theCell
Next i
'
End Sub
 
Hi
You can put the rolling total in E1

Sub TotalIt()
Total = Range("E1").Value
Range("E1").Value = Range("D1").Value + Total
End Sub

run this sub each time you change the numbers in the A column
regards
Paul
 
Hi Eric,

This is doing the trick, what do I need to do to add more cells.

e.g. I have A1:A3 to total in D1 I want to add C1:C3 to total in cell E1,
how will this be added to the code.

Many thanks

Mark
 
Just add one more check to the code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, j As Long
Dim nAreas As Long
Dim theCell As Range
'
nAreas = Target.Areas.Count
'
' Since "Target" can have multiple areas selected, we
' need to check each cell in each area to see if it is
' in the range "A1:A3" or the range "C1:C3"
'
For i = 1 To nAreas
For Each theCell In Target.Areas(i).Cells
If (Not Intersect(theCell, ActiveSheet.Range("A1:A3")) Is
Nothing) Then
ActiveSheet.Range("D1") = ActiveSheet.Range("D1") + theCell
ElseIf (Not Intersect(theCell, ActiveSheet.Range("C1:C3")) Is
Nothing) Then
ActiveSheet.Range("E1") = ActiveSheet.Range("E1") + theCell
End If
Next theCell
Next i
'
End Sub
 
Back
Top