Auto Sum VBA help

[tezza]

Hi

I'm looking to replace a set value (shown in a box with red) with an autosum value using VBA. (same idea for the Adjusted Column).

The Actual Column will autosum the values in the duration column for each group, basic example below. This needs to happen for all group totals based on number of rows filled in Col A

The example below would do the following until there's no data left:

D10 = Sum E3:E9
F10 = Sum F3:F9

D15 = Sum E11:E14
F15 = Sum E11:E14

D20 = Sum E16:E19
F20 = Sum F16:F19

With an additional sum two rows underneath the last row shows:

Col C(last row plus 2) = Sum Col C
Col D(last row plus 2) = Sum Col D

ECM Report 1 26-01-25.xlsx
	A	B	C	D	E	F
3	Monday 20/01/2025	A K		17:54 - 18:22	28	28
4	Tuesday 21/01/2025	A K		17:55 - 18:22	27	27
5	Wednesday 22/01/2025	D W		18:30 - 19:03	33	33
6	Thursday 23/01/2025	M W		18:15 - 18:36	21	21
7	Friday 24/01/2025	S C		18:32 - 18:59	27	27
8	Saturday 25/01/2025	S C		17:45 - 18:02	17	17
9	Sunday 26/01/2025	Y C		18:29 - 19:01	32	32
10	Totals		7	185	-45	185
11	Monday 20/01/2025	S C		10:45 - 11:45	60	60
12	Wednesday 22/01/2025	S M		10:25 - 11:24	59	59
13	Friday 24/01/2025	S M		10:54 - 11:59	65	65
14	Sunday 26/01/2025	J B		10:45 - 11:39	54	54
15	Totals		4	238	2	238
16	Tuesday 21/01/2025	J B		08:55 - 09:55	60	60
17	Wednesday 22/01/2025	S P		08:56 - 10:01	65	65
18	Thursday 23/01/2025	S J		09:04 - 10:02	58	58
19	Friday 24/01/2025	A Y		08:57 - 10:02	65	65
20	Totals		4	248	52	248
Report_1

Cell Formulas
Range	Formula
D10	D10	=SUM(E3:E9)
E10	E10	=140-D10
D15,D20	D15	=SUM(E11:E14)
E15	E15	=240-D15
F3:F9,F11:F14,F16:F19	F3	=MOD(RIGHT(D3,5)-LEFT(D3,5),1)*1440
F10	F10	=SUM(F3:F9)
F15,F20	F15	=SUM(F11:F14)
E20	E20	=300-D20

Thank you.

 

[Peter_SSs]

Am I correct in thinking that those 'Total' rows are empty in columns D:F before the code is run?

If so, you could try this (with a copy of your worksheet) for the column D & F formulas.
I don't understand the logic of the column E formulas.

Sub Sum_Formulas()
  Dim rA As Range
  
  For Each rA In Range("D3:D" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlConstants).Areas
    rA.Cells(rA.Rows.Count + 1).Formula = "=sum(" & rA.Offset(, 1).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 3).Formula = "=sum(" & rA.Offset(, 2).Address(0, 0) & ")"
  Next rA
End Sub

 

[tezza]

Am I correct in thinking that those 'Total' rows are empty in columns D:F before the code is run?

If so, you could try this (with a copy of your worksheet) for the column D & F formulas.
I don't understand the logic of the column E formulas.

Sub Sum_Formulas()
  Dim rA As Range
 
  For Each rA In Range("D3:D" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlConstants).Areas
    rA.Cells(rA.Rows.Count + 1).Formula = "=sum(" & rA.Offset(, 1).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 3).Formula = "=sum(" & rA.Offset(, 2).Address(0, 0) & ")"
  Next rA
End Sub

Hi Peter,

Thank you for the quick reply.

The data comes from a csv download which provides unformulated total rows so the totals row are populated.

Once I removed the data to test, it works fine. It just needs to overwrite the cells, please.

Col E needs to be left as it is as it has a fixed value.

 

[Peter_SSs]

OK, try this one

Sub Sum_Formulas_v2()
  Dim rA As Range
  
  For Each rA In Range("B3", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
    rA.Cells(rA.Rows.Count + 1, 3).Formula = "=sum(" & rA.Offset(, 3).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 5).Formula = "=sum(" & rA.Offset(, 4).Address(0, 0) & ")"
  Next rA
End Sub

 

[tezza]

Am I correct in thinking that those 'Total' rows are empty in columns D:F before the code is run?

If so, you could try this (with a copy of your worksheet) for the column D & F formulas.
I don't understand the logic of the column E formulas.

Sub Sum_Formulas()
  Dim rA As Range
 
  For Each rA In Range("D3:D" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlConstants).Areas
    rA.Cells(rA.Rows.Count + 1).Formula = "=sum(" & rA.Offset(, 1).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 3).Formula = "=sum(" & rA.Offset(, 2).Address(0, 0) & ")"
  Next rA
End Sub

Hi Peter,

This just seem to add values to the very bottom of the data.

 

[tezza]

OK, try this one

Sub Sum_Formulas_v2()
  Dim rA As Range
 
  For Each rA In Range("B3", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
    rA.Cells(rA.Rows.Count + 1, 3).Formula = "=sum(" & rA.Offset(, 3).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 5).Formula = "=sum(" & rA.Offset(, 4).Address(0, 0) & ")"
  Next rA
End Sub

I've noticed that when I go to B3 and press CTRL + Down arrrow that it goes straight to the bottom instead of going to the next blank cell at B10 for some reason. However, if I start at C3 it finds each number in turn. Maybe that will help you?

 

[Peter_SSs]

when I go to B3 and press CTRL + Down arrrow that it goes straight to the bottom

OK, so those apparently blank cells in col B are not actually empty - not too surprising coming from a csv.

if I start at C3 it finds each number in turn. Maybe that will help you?

Yes, that should help. Try this modification.

Sub Sum_Formulas_v3()
  Dim rA As Range
 
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    rA.Cells(rA.Rows.Count + 1, 2).Formula = "=sum(" & rA.Offset(, 2).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 4).Formula = "=sum(" & rA.Offset(, 3).Address(0, 0) & ")"
  Next rA
End Sub

 

[tezza]

OK, so those apparently blank cells in col B are not actually empty - not too surprising coming from a csv.



Yes, that should help. Try this modification.

Sub Sum_Formulas_v3()
  Dim rA As Range
 
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    rA.Cells(rA.Rows.Count + 1, 2).Formula = "=sum(" & rA.Offset(, 2).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 4).Formula = "=sum(" & rA.Offset(, 3).Address(0, 0) & ")"
  Next rA
End Sub

Thank you, works like a dream.

I just need a final touch, which is to sum col C and D three rows below the final totals, please.

ECM Report 1 26-01-25.xlsm
	A	B	C	D	E	F
35	Totals		3	125		125
36
37
38			27	1328
39
40
Report_1

Cell Formulas
Range	Formula
D35	D35	=SUM(E32:E34)
F35	F35	=SUM(F32:F34)
C38:D38	C38	=SUM(C3:C35)

 

[Peter_SSs]

I just need a final touch, which is to sum col C and D three rows below the final totals, please.

Sub Sum_Formulas_v4()
  Dim rA As Range
  
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    rA.Cells(rA.Rows.Count + 1, 2).Formula = "=sum(" & rA.Offset(, 2).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 4).Formula = "=sum(" & rA.Offset(, 3).Address(0, 0) & ")"
  Next rA
  Range("C" & Rows.Count).End(xlUp).Offset(3).Resize(, 2).FormulaR1C1 = "=sum(R3C:R[-3]C)"
End Sub

 

[tezza]

Sub Sum_Formulas_v4()
  Dim rA As Range
 
  For Each rA In Range("C3", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlBlanks).Areas
    rA.Cells(rA.Rows.Count + 1, 2).Formula = "=sum(" & rA.Offset(, 2).Address(0, 0) & ")"
    rA.Cells(rA.Rows.Count + 1, 4).Formula = "=sum(" & rA.Offset(, 3).Address(0, 0) & ")"
  Next rA
  Range("C" & Rows.Count).End(xlUp).Offset(3).Resize(, 2).FormulaR1C1 = "=sum(R3C:R[-3]C)"
End Sub

Perfect, thank you.