Loop that finds blanks, then subtotals values into different column

[Bevy]

Hi there,

0 rows are my header rows, and 1 rows are individual order items. I
need a loop that will find the blank cells in column E and then
subtotal the values into column C of its header row.

A B C D E
0 B100010
1 B100010 101303 1 82.92
1 B100010 101305 1 117.31
1 B100010 101307 1 90.02
0 B310003
1 B310003 215013 1 12.33
1 B310003 301503 1 10.75
0 B20055
1 B20055 303009 1 17.77
1 B20055 303011 1 25.67
1 B20055 303013 1 27.15
1 B20055 217001 1 31.55

I know it is basic stuff, but I need some help (I'm an excel VBA
virgin!!) I am ok with the looping bit but can't think it through. I
am running out of time and the will to live !! .... Anyone??? Thanks
in advance

 

[Ivan Raiminius]

Hi,

subtotal of what?

empty cells you can find using this:

dim emptycells as range
emptycells=intersect(range("e:e"),activesheet.usedrange).SpecialCells(xlCellTypeBlanks)

Regards,
Ivan

 

[Bevy]

subtotal of values in Column E - i.e. the total of each order. Cheers,
Bevy

 

[Ivan Raiminius]

Hi,

you can use something like this:

intersect(range("e:e"),activesheet.usedrange).SpecialCells(xlCellTypeBlanks).offset(0,1).formular1c1="=SUMIF("
&
intersect(range("a:a"),activesheet.usedrange).Address(referencestyle:=xlR1C1)
& ","
range("a1").Address(referencestyle:=xlR1C1,relativeto:=range("e1"),rowabsolute:=false,columnabsolute:=false)
& "," &
intersect(range("e:e"),activesheet.usedrange).Address(referencestyle:=xlR1C1)

Regards,
Ivan

 

[Guest]

Sub PutInTotals()
Dim rng as Range
Dim cell as Range
Dim rng1 as Range

set rng = Range(Cells(rows.count,"E"),Cells(rows.count,"E").End(xlup))
for each cell in rng
if isempty(cell) and not isempty(cell.offset(1,0)) then
if isempty(cell.offset(2,0)) then
cell.Formula = "=Sum(" & cell.Offset(1,0).Address(0,0) & ")"
else
set rng1 = range(cell.offset(1,0),cell.offset(1,0).End(xldown))
cell.Formula = "=Sum(" & rng1.Address(0,0) & ")"
end if
End if
Next
end sub