Sum Columns

[Wayne]

The following is an example of data that i have to sum
the columns.

There can be one to many sets of data with each set of
data sperated by an empty row.

I have code that will lookup data within column B and
will sum the column upto the first blank cell(see code
below) but I now require Columns D & E to have a simular
formula.

Having just got used to "messing" with macros and
reconfiguring them I was sure I would be able to crack
and alter the code... 2 hours later, and its back to
posting again.....Doh!!!!

Many, many thanks in advance

A B C D E
AREA 1296.40m2
109611 2 TIE BAR 0.8M M/S 0.36 2
109612 4 TIE BAR 1.2M 1.08 12.8
109618 32 TIE BAR 1.8M 8.96 160
109624 24 TIE BAR 2.4M 6.96 168



Sub GetSum()
Dim rng As Range, rng1 As Range
Dim rng2 As Range, cell As Range
Dim ar As Range
Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End
(xlUp))
Set rng1 = rng.Offset(0, 1).SpecialCells(xlBlanks)
Set rng2 = Range("B3")
For Each ar In rng1.Areas
Set cell = ar(1, 1)
cell.Formula = "=Sum(" & _
Range(rng2, cell.Offset(-1, 0)).Address & ")"
Set rng2 = cell.Offset(2, 0)
Next
End Sub

 

[Dave Peterson]

This may work for you if those values are all constants (no formulas).

Option Explicit
Sub testme()
Dim myRng As Range
Dim myArea As Range
Dim wks As Worksheet
Dim FormCell As Range
Dim myFormula As String

Set wks = Worksheets("Sheet1")

With wks
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("b2", .Cells(.Rows.Count, "B").End(xlUp)) _
.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "no constants"
Exit Sub
End If

For Each myArea In myRng.Areas
myFormula = "=sum(r[-1]c:r[-" & myArea.Cells.Count & "]c)"
Set FormCell = myArea.Cells(myArea.Cells.Count).Offset(1, 0)
With FormCell
.FormulaR1C1 = myFormula
.Offset(0, 2).FormulaR1C1 = myFormula
.Offset(0, 3).FormulaR1C1 = myFormula
End With
Next myArea
End With
End Sub