Macro to create totals

[Yardy2]

I have a problem that I need anyone's help with.

I have to do a monthly report that includes totalling a bunch of numbers on a spreadsheet. The numbers are seperated using a blank row and I have the totals offset at the bottom, to the right, in the blank row.

How can I do a macro to calculate the numbers in Column "F" and place the total in the Column "G" or even to place the total below the numbers in column "F".

For example:

A4236 27-Sep-04 8.50 6.80
A4236 27-Sep-04 7.00 5.60
------------------------------------ 12.40
A7083 24-Sep-04 4.00 3.20
A7083 24-Sep-04 4.00 3.20
A7083 20-Sep-04 4.25 3.40
A7083 17-Sep-04 4.25 3.40
A7083 17-Sep-04 4.25 3.40
A7083 3-Sep-04 2.75 2.20
------------------------------------- 18.80
B1761 27-Sep-04 1.00 0.80
B1761 27-Sep-04 2.50 2.00
B1761 27-Sep-04 2.50 2.00
B1761 27-Sep-04 4.50 3.60
B1761 27-Sep-04 2.00 1.60
B1761 24-Sep-04 2.50 2.00
B1761 3-Sep-04 6.50 5.20
-------------------------------------- 17.20
Thanks
Yardy

It is very tedious calculating the totals one by one.

 

[erik.van.geit]

Hi, Yardy2,

This code will place the totals in column F.

Kind regards,
Erik

Option Explicit

Sub totals_in_emptyrows()
Dim lcell As Range 'lastcell
Dim fcell As Range 'firstycell
Dim erow As Long 'ending row
Dim sumrange As Variant

Set fcell = Cells(1, 6)
erow = Cells(65536, 6).End(xlUp).Offset(1, 0).Row

Do
Set lcell = fcell.End(xlDown)
lcell.Offset(1, 0) = Application.WorksheetFunction.Sum(Range(fcell, lcell))
Set fcell = lcell.Offset(2, 0)
Loop Until lcell.Row + 1 = erow
End Sub

 

[acw]

Hi

Have you considered using the Data, Subtotal facility?


Tony

 

[Yardy2]

Thank you very much for the quick response. I really appreciate it.

The program is calculating the totals but not all lines. There is an error in this code: lcell.Offset(1, 0) = Application.WorksheetFunction.Sum(Range(fcell, lcell)).

Thanks again
Yardy

 

[Yardy2]

Tony

What is the Data, Subtotal facility?

Yardy2

 

[erik.van.geit]

which error do you get ?

I get no errors.
perhaps you've #Value or anything else in some cells ?

kind regards,
Erik

PS sleeping now

 

[Yardy2]

Erick,

The error is:

run-time error "1004"

Application-defined or object-defined error

It may be something I am doing wrong but you have been great help

Thanks
Yardy2

 

[Yardy2]

Erick,

Could the problem be that some of the cells only have 1 cell of data to total.

Yardy2

 

[acw]

Yardy2

Highlight the range you want to subtotal then select Data, Subtotals from the main menu. Put the subtotal at every break of whatever is in the first column.


Tony

 

[erik.van.geit]

Yardy,

The most difficult part of loops is starting end ending.
I didn't have much time left to look at this, so perhaps there is a better way, but this works for me. Even when there are more empty lines the sum will be added. Now the code isn't going anymore to ask for row 65537 which caused the problem

Wasn't acw's solution not an option?
At first sight, it looks good !

kind regards,
Erik

Option Explicit

Sub totals_in_emptyrows()
Dim lcell As Range 'lastcell
Dim fcell As Range 'firstycell
Dim erow As Long 'ending row
Dim sumrange As Variant

Set fcell = Cells(1, 6)'.End(xlDown)
erow = Cells(65536, 6).End(xlUp).Offset(1, 0).Row

Do
If fcell.Offset(1, 0) <> "" Then Set lcell = fcell.End(xlDown) Else Set lcell = fcell
lcell.Offset(1, 0) = Application.WorksheetFunction.Sum(Range(fcell, lcell))
Set fcell = lcell.Offset(1, 0)
  Do
  Set fcell = fcell.Offset(1, 0)
  Loop Until fcell.Value <> "" Or fcell.Row = erow + 1
Loop Until lcell.Row + 1 = erow
End Sub