Sum above

[Renate]

Hi all,

I am trying to create a macro that will sum all the values in column H
and will put the result in Column I. The macro should only use a range
with cells with values and stop if a blanco cell is found. Something
like the Sum(Above) function that's builtin in Word.
It shouldn't be necessary for the user to have the cursor in the
correct colum (H) but only in the correct row. The idea is that the
code looks for the values in column H starting from the row above the
activecell until a blanc cell is found.

I was able to create some code that does that but the problem is the
..End property doesn't work correctly cause column H has formulas in
each cell therefor causing my macro to always create a formula
=SUM($H$1:$H$17)
instead of
=SOM($H$4:$H$17)
cause H1 to H3 contain a formula but no value


This is the code I've used:
----------------------------------------------------------------------------------------------------------------------
Dim sAddress As String
Dim oRange As Range
Dim oSumRange As Range
Dim lColumn As Long
Dim lRow As Long

lRow = ActiveCell.Row
lColumn = ActiveCell.Column
If lColumn <> 8 Then
Set oRange = ActiveSheet.Cells(lRow, 8)
Else
Set oRange = ActiveCell
End If
Set oRange = oRange.End(xlUp).End(xlUp)
sAddress = oRange.Address

Set oSumRange = ActiveSheet.Cells(lRow, 9)
oSumRange.Formula = "=SUM(" & sAddress & ":" & oRange(lRow,
1).Address & ")"

Set oSumRange = Nothing
Set oRange = Nothing
----------------------------------------------------------------------------------------------------------------------

Can somebody please help me to get the result that I need?

TIA
Renate

 

[Jim Rech]

Change one line to this:

Set oRange = oRange.End(xlUp).End(xlUp).SpecialCells(xlCellTypeConstants)

 

[Renate]

Hi Jim,

Change one line to this:

Set oRange = oRange.End(xlUp).End(xlUp).SpecialCells(xlCellTypeConstants)

Thanks for your response! Unfortunately this doesn' t work. All the
cells in the range contain a formula which evaluates either to a zero
length string or to a number.
I'm looking for a method to only sum the cells above which result is a
number.
I've tried to set the SpecialCells value to xlNumbers but then I get an
error that no cells are found.
Any other ideas perhaps?

TIA
Renate

 

[Jim Rech]

I'm puzzled about your concern with including formulas returning text values
in the sum range. Text has a numerical value of zero so it does not affect
the result.

You might try this.

On Error Resume Next
Set oRange = oRange.End(xlUp).End(xlUp).SpecialCells(xlCellTypeFormulas,
xlNumbers)
If Not oRange Is Nothing Then
''Enter formula
Else
''Do what you want
End If
On Error Goto 0

 

[Leo Heuser]

Hi all,

I am trying to create a macro that will sum all the values in column H
and will put the result in Column I. The macro should only use a range
with cells with values and stop if a blanco cell is found. Something
like the Sum(Above) function that's builtin in Word.
It shouldn't be necessary for the user to have the cursor in the
correct colum (H) but only in the correct row. The idea is that the
code looks for the values in column H starting from the row above the
activecell until a blanc cell is found.

I was able to create some code that does that but the problem is the
.End property doesn't work correctly cause column H has formulas in
each cell therefor causing my macro to always create a formula
=SUM($H$1:$H$17)
instead of
=SOM($H$4:$H$17)
cause H1 to H3 contain a formula but no value


This is the code I've used:
----------------------------------------------------------------------------------------------------------------------
Dim sAddress As String
Dim oRange As Range
Dim oSumRange As Range
Dim lColumn As Long
Dim lRow As Long

lRow = ActiveCell.Row
lColumn = ActiveCell.Column
If lColumn <> 8 Then
Set oRange = ActiveSheet.Cells(lRow, 8)
Else
Set oRange = ActiveCell
End If
Set oRange = oRange.End(xlUp).End(xlUp)
sAddress = oRange.Address

Set oSumRange = ActiveSheet.Cells(lRow, 9)
oSumRange.Formula = "=SUM(" & sAddress & ":" & oRange(lRow,
1).Address & ")"

Set oSumRange = Nothing
Set oRange = Nothing
----------------------------------------------------------------------------------------------------------------------

Can somebody please help me to get the result that I need?

TIA
Renate

Hi Renate

Here's one way to do it.

You say "starting from the row above ", but your code starts in the active
cell.
I have used the active cell.
The code builds on the fact, that for a cell containing a zero-length string
""
(Cell.value="") is True, while (IsEmpty(Cell)) is False
For an empty cell both are True. So this is a way to distinguish between
an empty cell and a cell containing ""


Sub test()
Dim sAddress As String
Dim oRange As Range
Dim oSumRange As Range
Dim lColumn As Long
Dim lRow As Long


lRow = ActiveCell.Row
lColumn = ActiveCell.Column
If lColumn <> 8 Then
Set oRange = ActiveSheet.Cells(lRow, 8)
Else
Set oRange = ActiveCell
End If

sAddress = oRange.Address

On Error Resume Next

Do
If oRange.Value = "" Then
If Not IsEmpty(oRange) Then
Set oRange = oRange.Offset(1, 0)
Exit Do
End If
End If

Set oRange = oRange.Offset(-1, 0)
Loop Until Err.Number <> 0

On Error GoTo 0

Set oSumRange = ActiveSheet.Cells(lRow, 9)

oSumRange.Formula = "=SUM(" & sAddress & ":" & _
oRange.Address & ")"

Set oSumRange = Nothing
Set oRange = Nothing
End Sub