"Renate" skrev i en meddelelse
ps.com...
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



--
Best regards
Leo Heuser

Followup to newsgroup only please.