Macro for Sub Totals
 

Hi All
I am trying to create a Macro that places sub totals in a column of data.
The data is imported from a RTF file and already has sub totals in place in
bold font.
These are obviously just a number. There a couple of other issues making
this difficult though.
1. each block of data may or may not be contigous There may be gaps
2. each block of data is dynamic and may change in amounts and number of
rows,etc
3. No adjoining column has a unique set of identifiers which I could use to
do a DATA / SUBTOTALS search.
4. The data range is approx 400 lines * 7 columns and may change in size at
any time.
See example data below :
Any assistance would be greatly appreciated
Regards
Michael M

QUANTITY UNIT RATE TOTAL
1 lump 12,000 12,000
1 lump 2,000 2,000
1 item 121,440 121,440
60 week 1,400 1,400

219,440 BOLD FONT
Blank Line
Blank line
1 kg 12,000 25,000
1 day 2,000 6,000
1 month 121,440 100,600
60 week 1,400 400

131,700 BOLD FONT

Macro for Sub Totals
 

Hi All
Further to the request below.
I have added the following macro so that all blank cells in the sub total
column are now zero.
Sub Addzero()
Dim rngAct As Range
Worksheets("PRICE CULVERT OPTION").Activate
For Each rngAct In Range("G12:G20").Cells
If rngAct = "" Then rngAct = 0
Next rngAct
Worksheets("MAIN MENU").Activate
End Sub

I have done this in the hope that we can sum each group of data between the
"bold " cells, but I'm stuck from there.
Does this help anyone, help me ??

I can then rerun a similar macro to delete all the remaining zeros after we
have subtotals.
Regards
Michael M

"Michael M" wrote:

Hi All
I am trying to create a Macro that places sub totals in a column of data.
The data is imported from a RTF file and already has sub totals in place in
bold font.
These are obviously just a number. There a couple of other issues making
this difficult though.
1. each block of data may or may not be contigous There may be gaps
2. each block of data is dynamic and may change in amounts and number of
rows,etc
3. No adjoining column has a unique set of identifiers which I could use to
do a DATA / SUBTOTALS search.
4. The data range is approx 400 lines * 7 columns and may change in size at
any time.
See example data below :
Any assistance would be greatly appreciated
Regards
Michael M

QUANTITY UNIT RATE TOTAL
1 lump 12,000 12,000
1 lump 2,000 2,000
1 item 121,440 121,440
60 week 1,400 1,400

219,440 BOLD FONT
Blank Line
Blank line
1 kg 12,000 25,000
1 day 2,000 6,000
1 month 121,440 100,600
60 week 1,400 400

131,700 BOLD FONT

Macro for Sub Totals
 

Hi All
My problem has been resolved, with many thanks to Stanley & Jindon.
For thos that may be interested, here is the code, with a little extra that
colours the subtotal cell with a yellow background.
Sub SubTots()
Dim r As range, s As Long
s = 12 '<- starting Row reference will be used in the formula next
For Each r In range("g12:g750")
If r.Font.Bold = True Then
With r ' when Bold cell found, s will be used in the formula
.FormulaR1C1 = "=sum(r" & s & "c:r" & r.Row - 1 & "c)"
.Interior.Color = vbYellow
End With
s = r.Row + 1 '<- s will be the next row reference of Bold Cell for
next formula
End If
Next
End Sub

Many thanks to all that may have put some thought to this problem
Regards
Michael M

"Michael M" wrote:

Hi All
I am trying to create a Macro that places sub totals in a column of data.
The data is imported from a RTF file and already has sub totals in place in
bold font.
These are obviously just a number. There a couple of other issues making
this difficult though.
1. each block of data may or may not be contigous There may be gaps
2. each block of data is dynamic and may change in amounts and number of
rows,etc
3. No adjoining column has a unique set of identifiers which I could use to
do a DATA / SUBTOTALS search.
4. The data range is approx 400 lines * 7 columns and may change in size at
any time.
See example data below :
Any assistance would be greatly appreciated
Regards
Michael M

QUANTITY UNIT RATE TOTAL
1 lump 12,000 12,000
1 lump 2,000 2,000
1 item 121,440 121,440
60 week 1,400 1,400

219,440 BOLD FONT
Blank Line
Blank line
1 kg 12,000 25,000
1 day 2,000 6,000
1 month 121,440 100,600
60 week 1,400 400

131,700 BOLD FONT