Summarize areas

[Kjellk]

I would like to take the highest value minus the lowest value in groups that
are divided by a blank row. The group can consist of different number of
rows. Would like to have the result in the cell to the right of the row at
the bottom of the group.

This is how it looks

16235
16300
16368 (Sum here!)

16375
16419
16442
16481 (Sum here!)

 

[Don Guillett]

Should do it

Sub sumblocks()
Dim mc, i, x As Long
mc = 4 ' col D change to suit
For i = Cells(Rows.Count, mc). _
End(xlUp).Row To 2 Step -1
If Len(Application.Trim(Cells(i + 1, mc))) < 1 Then
Cells(i + 1, mc) = ""
x = Cells(i, mc).End(xlUp).Row
Cells(i, mc).Offset(, 1).Value = _
Application.Sum(Range(Cells(i, mc), Cells(x, mc)))
End If
Next i
End Sub

 

[Kjellk]

Hi Don
Thank you for your answer; this it how it looks:
16235
16300
16368 48903

16375
16419
16442
16481 65717

Since I have not been clear enough I have to tell you that what I wanted was
the sum of 16238 - 16235=133 in group one and the sum of 16481-16375 = 106 in
group to. Can you kindly help me with that?

Regards
Kjell

 

[Don Guillett]

You should have been able to figure it out...
You said 16238 - 16235
did you mean 16368-16235

Sub sumblocks()
Dim mc, i, x As Long
mc = 4 ' col D
For i = Cells(Rows.Count, mc). _
End(xlUp).Row To 2 Step -1
If Len(Application.Trim(Cells(i + 1, mc))) < 1 Then
Cells(i + 1, mc) = ""
x = Cells(i, mc).End(xlUp).Row
'subtract first from last
Cells(i, mc).Offset(, 1).Value = _
Cells(i, mc) - Cells(x, mc)

'sum
'Cells(i, mc).Offset(, 1).Value = _
'Application.Sum(Range(Cells(i, mc), Cells(x, mc)))
End If
Next i
End Sub

 

[Kjellk]

Hi Don
Thanks again - yes, I said wrong but you figured it out!
It is nearly korrekt now but the first two groups is showing the highest
value one row under the result in that group. I can live with that but if you
can fix that also I would be very glad.

14627
14744
14751 124
-14751

14751
14821
14892 141
-14892

14894
14925
14971 77

14971
14987
15003 32

15010
15072
15134 124

15154
15203
15238
15278 124

I am very glad for your engagement - you have saved a lot of hours of
unqualified work from my side.
Regards
Kjell

---------------------------------------------------------------------------

 

[Don Guillett]

I just tested. IF you have TWO blank rows I get the extra under the next
column.
14627
14744
14751 124
-14751

14751
14821
14892 141
-14892


So, this accounts for 2 blank rows

Sub sumblocks()
Dim mc, i, x As Long
mc = 2 ' col D
For i = Cells(Rows.Count, mc). _
End(xlUp).Row To 2 Step -1
If Len(Application.Trim(Cells(i + 1, mc))) < 1 _
And Len(Application.Trim(Cells(i, mc))) <> 0 Then
Cells(i + 1, mc) = ""
x = Cells(i, mc).End(xlUp).Row
Cells(i, mc).Offset(, 1).Value = _
Cells(i, mc) - Cells(x, mc)
'Cells(i, mc).Offset(, 1).Value = _
'Application.Sum(Range(Cells(i, mc), Cells(x, mc)))
End If
Next i
End Sub

 

[Kjellk]

Hi again.
You are incredible. Not only that you know what you are doing- you also know
what I am doing wrong.
A thousand thanks!
Kjell

 

[Don Guillett]

Glad to help