Rolling Total

[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

 

[EricG]

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

 

[Paul Robinson]

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

 

[terilad]

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

 

[EricG]

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

 

[terilad]

Excellant,

many thanks for your help, really much appreciated.

Regards

Mark

 

[Paul Robinson]

glad to help
Paul

Excellant,

many thanks for your help, really much appreciated.

Regards

Mark