# Macro to create totals

#### Yardy2

##### New Member
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.

### Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Hi, Yardy2,

This code will place the totals in column F.

Kind regards,
Erik

Code:
``````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``````

Hi

Have you considered using the Data, Subtotal facility?

Tony

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

Tony

What is the Data, Subtotal facility?

Yardy2

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

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

Erick,

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

Yardy2

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

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

Code:
``````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``````

Replies
6
Views
383
Replies
15
Views
397
Replies
10
Views
355
Replies
3
Views
1K
Replies
3
Views
214

1,203,668
Messages
6,056,653
Members
444,880
Latest member
Kinger1968

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back