Paging Toppers for the macro

[Guest]

from previous post "how to sum this easily"...

please help me with the macro to adjust with the following
"Ineed to have some heading space on the top of myfile"....

1. the data range to be summed is G10:G2000 (previously Column A)
2. the negative ref. values - criteria range is on H10:H2000 (previously
Column B)
3. the positive ref. values + criteria range is on I10:I2000 (also
previously on Column B).
4. the sum result range (for the negative ref. criteria) is on K10:K2000
5. the sum result range (for the positive ref. criteria) is on L10:L2000
6. I place in Cell K9 a certain value for a sumif range criteria.....e.g. if
i place there a value of 10, then it means i only need to sum the multi-range
in G2:G2000 if the Absolute MAX ref. Value on column H & I is equal or
greater than cell K9...

i know this will do the trick for me to have an instant charting of the
summed results on multi-range...

THANKS A LOT...
regards

 

[Guest]

Try this (assuming I understood the requirements:

Sub sumitx()

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

maxlimit = Cells(9, "K") ' Store max limit

For n = 8 To 9 ' Loop through columns H & I

Cells(10, n + 3).Resize(2000, 1).ClearContents ' Clear columns K & L

lastrow = Cells(Rows.Count, n).End(xlUp).Row
sr = 9
Do
Do
sr = sr + 1
Loop Until Cells(sr, n) <> 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, n)) > Abs(maxb) Then
maxb = Cells(sr, n)
End If
sr = sr + 1
Loop Until Cells(sr, n) = 0
r2 = sr - 1
If Abs(maxb) >= maxlimit Then ' Check if max exceeds threshold ......
Set rnga = Range(Cells(r1, "G"), Cells(r2, "G"))
Set rngb = Range(Cells(r1, n), Cells(r2, n))
tot = Application.Sum(rnga)
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Cells(rmax, n + 3) = tot
End If

Loop Until sr >= lastrow
Next n

End Sub

 

[Guest]

Hi Toppers

thanks it works perfect...you did understand every-bit of the explanation,
yet it was me who forgot to add one last condition.....

7. I have cell Q9 which i have to input either 1 or 0...
if Q9 = 0 ; the sum result will be adjacent on the max/min points - THE
WAY MACRO CURRENTLY DOES...
if Q9 = 1 ; the sum result will be adjacent on the first cell FOUND where
the sum RESULT range is reckoned with...<This will make me trace the location
of the first cell included in each sum range>...

i hope there will be no looping problem in the macro due to "Q9"
introduction...

really thanks

driller

 

[Guest]

try:

Sub sumitx()

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

maxlimit = Cells(9, "K") ' Store max limit
rowflag = Cells(9, "Q")

For n = 8 To 9 ' Loop through columns H & I

Cells(10, n + 3).Resize(2000, 1).ClearContents ' Clear columns K & L

lastrow = Cells(Rows.Count, n).End(xlUp).Row
sr = 9
Do
Do
sr = sr + 1
Loop Until Cells(sr, n) <> 0
r1 = sr
maxb = 0
Do
If Abs(Cells(sr, n)) > Abs(maxb) Then
maxb = Cells(sr, n)
End If
sr = sr + 1
Loop Until Cells(sr, n) = 0
r2 = sr - 1
If Abs(maxb) >= maxlimit Then ' Check if max exceeds threshold ......
Set rnga = Range(Cells(r1, "G"), Cells(r2, "G"))
Set rngb = Range(Cells(r1, n), Cells(r2, n))
tot = Application.Sum(rnga)
If rowflag = 0 Then ' Check where to place result ....
rmax = Application.Match(maxb, rngb, 0) + r1 - 1
Else
rmax = r1
End If
Cells(rmax, n + 3) = tot
End If

Loop Until sr >= lastrow
Next n

End Sub

 

[Guest]

TOPPERS,

i don't know how to thank you...

you did it so fast and perfect!!!

THANKS and BEST REGARDS