Diifficult Range & Sum

[excelliot]

I have following data imported fom text files. It is just slice of it, actually it conains more than 10,000 rows approx. I wants to do follwing action on it.1)Look in to Coloumn B for word sales & store the position in counter.If it has word sales than do following action;2)Offset one row down.3)Select range starting from the active cell to the end of selection (not till the end of the coloumn in given case B15 to B20.)4)Now also select range D15 to D20 corresponding to B15 to B20.5)Now for selected range D15 to D20 check for each cell gor poistive value, if it has than sum all positive value & similarly check for negative value & sum all negative value & store in to counter6)Now paste positive value in E14 & negative in F147)Now delete all row selected by range B15 to B208)Now repeat step 1 again SalesPromoter : J0183CEE CEMENTA1234A.T.ENTERPRISE-300A1456B.T.ENTERPRISE-7700A2999C.T.ENTERPRISE844251A2980D.T.ENTERPRISE359000A3022F.T.ENTERPRISE15400A3055J.T.ENTERPRISE58400SP OTHERTotalof Sales Promoter1269051SalesPromoter : J0184BEE CEMENTA2999C.T.ENTERPRISE-300A2980D.T.ENTERPRISE-7700A3022F.T.ENTERPRISE844251Totalof Sales Promoter844251

[mdmackillop]

Try the following. If you're doing it on your sample sheet, move the instructions out of column B as this will affect the Find
[VBA] Option Explicit
Option Compare Text
Sub RangeSum()
Dim c As Range, FirstAddress As String
Application.ScreenUpdating = False
With ActiveSheet.Range("B:B")
Set c = .Find("Sales", LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
DoTotals c
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Set c = Nothing
Application.ScreenUpdating = True
End Sub

Sub DoTotals(c As Range)
Dim Cement As Range, cel As Range
Dim iPlus As Long, iNeg As Long

iPlus = 0
iNeg = 0

Set Cement = Range(c.Offset(1), c.End(xlDown)).Offset(, 2)
For Each cel In Cement
If cel > 0 Then
iPlus = iPlus + cel
Else
iNeg = iNeg + cel
End If
Next
c.Offset(, 3) = iPlus
c.Offset(, 4) = iNeg
Cement.EntireRow.Delete
Set Cement = Nothing

End Sub
[/VBA]

[excelliot]

Good work

But it is very difficult to understand for me
can it be done in simple way

[mdmackillop]

I think this is as simple as it gets. A short explanation
Sub RangeSum looks for each occurence Sales in Col. B and passes each address in turn to DoTotals
DoTotals gets the Cement range by selecting one cell below Sales to the end of that block, and offsetting it by 2 columns
Each cell in Cement is then totalled, either into a Plus or Minus variable, which is then stored in Col E or F on the same row as sales.

Try stepping through the code and see what happens. You could add in lines such as Cement.select to see the range as it is selected.