Based on your stated need, after sorting on these fields, you could get the
grouping/sum using the built in Data=Subtotal function (turn on the macro
recorder while you do it manually to get the code).

Once you have the subtotals miplaced, you could loop through the subtotal
cells and make a decision on whether it is equal to zero or not. Then you
could delete the rows above by using the directpredent property of the cell
containing the subtotal.

--
Regards,
Tom Ogilvy


"Ctech" wrote in
message ...

Im getting closer, however I'm not there yet.. as After one run throught
the "Do", is goes off track.

ANyone see the problem?


Sub DeleteSumTotalZero()
'
' Macro1 Macro
' Macro recorded 04/10/2005 by Taylor Nelson Sofres plc
'

'

Dim DelRg As Range
Dim Cell As Range
Dim Numb As Long

Dim Output As String
Dim RangeX As Range
Dim sName As String
Set RangeX = Nothing


Numb = 0
' Selects the first cell in the cost centre column

Range("H3").Select



' Add next row to range if it is the same CC and suppliers as the row
above


Do

If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value _
And ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1).Value
Then

ActiveCell.Offset(0, 1).Select
With Selection.Interior
ColorIndex = 3
Pattern = xlSolid
End With
ActiveCell.Offset(0, -1).Select
Numb = Numb + 1
ActiveCell.Offset(0, 3) = Numb
ActiveCell.Offset(1, 0).Select

Else


Address = ActiveCell.Offset("-" & Numb, 2).Address
AddressAbove = ActiveCell.Offset(-1, 2).Address


Range(Address, AddressAbove).Select

sName = "'" & ActiveSheet.Name & "'!"

Output = Selection.Address( _
External:=False, RowAbsolute:=False, _
ColumnAbsolute:=False) & ")"

Output = Replace(Output, ",", "," & sName)

Output = "=sum(" & sName & Output

ActiveCell.Offset(0, 1) = Output
ActiveCell.Offset(0, 1).Select
AddresseY = ActiveCell.Address





If ActiveCell.Value = 0 Then
ActiveCell.Offset(Numb, -3).Select
Numb = 0
ActiveCell.Offset(1, 0).Select
Else

ActiveCell.Offset(Numb, 0).Select
With Selection.Interior
ColorIndex = 4
Pattern = xlSolid
End With
Numb = 0

End If



End If




Loop Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(0, 1))

Range("H2").Select
TheEnd:
MsgBox ("All Suppliers under Cost centres which adds up to 0 is now
deleted.")


End Sub


--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=473291