hello again gangs,

below is my sample data
A B C
10 0
10 1.00
14 2.00 =(10+14+12+10)=46
12 1.50
10 0.50
16 0
10 0
10 -0.90
8 -1.90
12 -2.00 =(10+8+12+10)=40
10 -1.80
10 0
10 1.00
---------------------------

i need to sum many SEPARATE ranges in column A, if column B <0, and place
the summed range total on column C where the max or min value (other than 0)
on column B is adjacent.
i do not have blank cells ....

really tried this but maybe i can't just do it without this forum...

regards
driller
--
*****
birds of the same feather flock together..

Hi,
Try this macro:

Sub sumit()

Dim rnga As Range, rngb As Range
Dim r1 As Long, r2 As Long, sr As Long, lastrow As Long, rmax As Long
Dim tot As Double, maxb As Double

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
sr = 0
Do
Do
sr = sr + 1
Loop Until Cells(sr, "B") < 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, "B")) Abs(maxb) Then
maxb = Cells(sr, "B")
End If
sr = sr + 1
Loop Until Cells(sr, "B") = 0
r2 = sr - 1
Set rnga = Range(Cells(r1, "A"), Cells(r2, "A"))
Set rngb = Range(Cells(r1, "B"), Cells(r2, "B"))
tot = Application.Sum(rnga)
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Cells(rmax, "C") = tot

Loop Until sr = lastrow

End Sub

HTH

"driller" wrote:

hello again gangs,

below is my sample data
A B C
10 0
10 1.00
14 2.00 =(10+14+12+10)=46
12 1.50
10 0.50
16 0
10 0
10 -0.90
8 -1.90
12 -2.00 =(10+8+12+10)=40
10 -1.80
10 0
10 1.00
---------------------------

i need to sum many SEPARATE ranges in column A, if column B <0, and place
the summed range total on column C where the max or min value (other than 0)
on column B is adjacent.
i do not have blank cells ....

really tried this but maybe i can't just do it without this forum...

regards
driller
--
*****
birds of the same feather flock together..

Hi Toppers,
thanks for your concerned reply, i never thought that summing it easily
needs a macro,,,
i did tested it and it do serve the purpose in the first case,,,i dont want
to change anything in this macro so if you could please adjust it with
something like this...

the data on col.B [-/0/+] are updated everytime for surveying works....
so when i try to replace values on the zero's (0) and run the macro
Again---then the result of the first macro-run are not re-updated....can u
make your macro to clear previous results on col.B when a second or third
re-run of macro...

thanks a lot..and more power
regards
--
*****
birds of the same feather flock together..



"Toppers" wrote:

Hi,
Try this macro:

Sub sumit()

Dim rnga As Range, rngb As Range
Dim r1 As Long, r2 As Long, sr As Long, lastrow As Long, rmax As Long
Dim tot As Double, maxb As Double

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
sr = 0
Do
Do
sr = sr + 1
Loop Until Cells(sr, "B") < 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, "B")) Abs(maxb) Then
maxb = Cells(sr, "B")
End If
sr = sr + 1
Loop Until Cells(sr, "B") = 0
r2 = sr - 1
Set rnga = Range(Cells(r1, "A"), Cells(r2, "A"))
Set rngb = Range(Cells(r1, "B"), Cells(r2, "B"))
tot = Application.Sum(rnga)
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Cells(rmax, "C") = tot

Loop Until sr = lastrow

End Sub

HTH

"driller" wrote:

hello again gangs,

below is my sample data
A B C
10 0
10 1.00
14 2.00 =(10+14+12+10)=46
12 1.50
10 0.50
16 0
10 0
10 -0.90
8 -1.90
12 -2.00 =(10+8+12+10)=40
10 -1.80
10 0
10 1.00
---------------------------

i need to sum many SEPARATE ranges in column A, if column B <0, and place
the summed range total on column C where the max or min value (other than 0)
on column B is adjacent.
i do not have blank cells ....

really tried this but maybe i can't just do it without this forum...

regards
driller
--
*****
birds of the same feather flock together..

I am asuming you want the results in column C cleared (not column B!):

Sub sumit()

Dim rnga As Range, rngb As Range
Dim r1 As Long, r2 As Long, sr As Long, lastrow As Long, rmax As Long
Dim tot As Double, maxb As Double

Columns(3).ClearContents ' Clear column C

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
sr = 0
Do
Do
sr = sr + 1
Loop Until Cells(sr, "B") < 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, "B")) Abs(maxb) Then
maxb = Cells(sr, "B")
End If
sr = sr + 1
Loop Until Cells(sr, "B") = 0
r2 = sr - 1
Set rnga = Range(Cells(r1, "A"), Cells(r2, "A"))
Set rngb = Range(Cells(r1, "B"), Cells(r2, "B"))
tot = Application.Sum(rnga)
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Cells(rmax, "C") = tot

Loop Until sr = lastrow

End Sub

"driller" wrote:

Hi Toppers,
thanks for your concerned reply, i never thought that summing it easily
needs a macro,,,
i did tested it and it do serve the purpose in the first case,,,i dont want
to change anything in this macro so if you could please adjust it with
something like this...

the data on col.B [-/0/+] are updated everytime for surveying works....
so when i try to replace values on the zero's (0) and run the macro
Again---then the result of the first macro-run are not re-updated....can u
make your macro to clear previous results on col.B when a second or third
re-run of macro...

thanks a lot..and more power
regards
--
*****
birds of the same feather flock together..



"Toppers" wrote:

Hi,
Try this macro:

Sub sumit()

Dim rnga As Range, rngb As Range
Dim r1 As Long, r2 As Long, sr As Long, lastrow As Long, rmax As Long
Dim tot As Double, maxb As Double

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
sr = 0
Do
Do
sr = sr + 1
Loop Until Cells(sr, "B") < 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, "B")) Abs(maxb) Then
maxb = Cells(sr, "B")
End If
sr = sr + 1
Loop Until Cells(sr, "B") = 0
r2 = sr - 1
Set rnga = Range(Cells(r1, "A"), Cells(r2, "A"))
Set rngb = Range(Cells(r1, "B"), Cells(r2, "B"))
tot = Application.Sum(rnga)
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Cells(rmax, "C") = tot

Loop Until sr = lastrow

End Sub

HTH

"driller" wrote:

hello again gangs,

below is my sample data
A B C
10 0
10 1.00
14 2.00 =(10+14+12+10)=46
12 1.50
10 0.50
16 0
10 0
10 -0.90
8 -1.90
12 -2.00 =(10+8+12+10)=40
10 -1.80
10 0
10 1.00
---------------------------

i need to sum many SEPARATE ranges in column A, if column B <0, and place
the summed range total on column C where the max or min value (other than 0)
on column B is adjacent.
i do not have blank cells ....

really tried this but maybe i can't just do it without this forum...

regards
driller
--
*****
birds of the same feather flock together..

Toppers,

thanks it work

i'll close this post now and will extend my inquiry on the next post "paging
Toppers" in a few minutes...

regards and more power...
--
*****
birds of the same feather flock together..



"Toppers" wrote:

I am asuming you want the results in column C cleared (not column B!):

Sub sumit()

Dim rnga As Range, rngb As Range
Dim r1 As Long, r2 As Long, sr As Long, lastrow As Long, rmax As Long
Dim tot As Double, maxb As Double

Columns(3).ClearContents ' Clear column C

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
sr = 0
Do
Do
sr = sr + 1
Loop Until Cells(sr, "B") < 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, "B")) Abs(maxb) Then
maxb = Cells(sr, "B")
End If
sr = sr + 1
Loop Until Cells(sr, "B") = 0
r2 = sr - 1
Set rnga = Range(Cells(r1, "A"), Cells(r2, "A"))
Set rngb = Range(Cells(r1, "B"), Cells(r2, "B"))
tot = Application.Sum(rnga)
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Cells(rmax, "C") = tot

Loop Until sr = lastrow

End Sub

"driller" wrote:

Hi Toppers,
thanks for your concerned reply, i never thought that summing it easily
needs a macro,,,
i did tested it and it do serve the purpose in the first case,,,i dont want
to change anything in this macro so if you could please adjust it with
something like this...

the data on col.B [-/0/+] are updated everytime for surveying works....
so when i try to replace values on the zero's (0) and run the macro
Again---then the result of the first macro-run are not re-updated....can u
make your macro to clear previous results on col.B when a second or third
re-run of macro...

thanks a lot..and more power
regards
--
*****
birds of the same feather flock together..



"Toppers" wrote:

Hi,
Try this macro:

Sub sumit()

Dim rnga As Range, rngb As Range
Dim r1 As Long, r2 As Long, sr As Long, lastrow As Long, rmax As Long
Dim tot As Double, maxb As Double

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
sr = 0
Do
Do
sr = sr + 1
Loop Until Cells(sr, "B") < 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, "B")) Abs(maxb) Then
maxb = Cells(sr, "B")
End If
sr = sr + 1
Loop Until Cells(sr, "B") = 0
r2 = sr - 1
Set rnga = Range(Cells(r1, "A"), Cells(r2, "A"))
Set rngb = Range(Cells(r1, "B"), Cells(r2, "B"))
tot = Application.Sum(rnga)
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Cells(rmax, "C") = tot

Loop Until sr = lastrow

End Sub

HTH

"driller" wrote:

hello again gangs,

below is my sample data
A B C
10 0
10 1.00
14 2.00 =(10+14+12+10)=46
12 1.50
10 0.50
16 0
10 0
10 -0.90
8 -1.90
12 -2.00 =(10+8+12+10)=40
10 -1.80
10 0
10 1.00
---------------------------

i need to sum many SEPARATE ranges in column A, if column B <0, and place
the summed range total on column C where the max or min value (other than 0)
on column B is adjacent.
i do not have blank cells ....

really tried this but maybe i can't just do it without this forum...

regards
driller
--
*****
birds of the same feather flock together..