Been working on it for a bit, its better I think. But it still doesn't
work


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

'

Dim DelRg As Range
Dim Cell As Range



' Sort the table after Cost Centres (CC) and then after Supplier

Selection.Sort Key1:=Range("H2"), Order1:=xlAscending,
Key2:=Range("I2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom

' Setting the different Sup = Supplier - CC = Cost Centre

Set Sup = Nothing
Set CC = Nothing
Set RC = Nothing
Set DelRg = Nothing
' Selects the first cell in the cost centre column

Range("h2").Select

For Each Cell In Selection.SpecialCells(x1CellTypeConstants)

' Sets active Cell = CC

CC = ActiveCell
Sup = ActiveCell.Offset(0, 1)

ActiveCell.Offset(1, 0).Select

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

If ActiveCell.Value = CC And ActiveCell.Offset(0, 1).Value = Sup
Then
AddToUnion Cell.Offset(0, 2), DelRg

' If Row is not equal to the one above then check if Total sum of
Range = 0

ElseIf Not Cell.Value = CC And Cell.Offset(0, 1).Value = Sup Then

' Check if Range is Nothing

If Not DelRg Is Nothing Then
DelRg.Select

' If Row Total is = 0 then delete Range

If DelRg.Subtotal = 0 Then
DelRg.EntireRow.Select.Delete x1ToLeft

End If
End If

' Checks if the cell is blank if it is GoTo End

ElseIf IsEmpty(ActiveCell) Then GoTo TheEnd
End If

Next Cell

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


End Sub

Sub AddToUnion(Cell As Range)
If DelRg Is Nothing Then
Set DelRg = Cell
Else
Set DelRg = Union(DelRg, Cell)
End If
End Sub


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

New update:

This time it runs through with no errors however I don't think it doe
what its supposed to do.



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

'
Dim Sup As Long
Dim CC As Long
Dim RC As Long

Dim DelRg As Range
Dim Cell As Range



' Sort the table after Cost Centres (CC) and then after Supplier

Selection.Sort Key1:=Range("H2"), Order1:=xlAscending,
Key2:=Range("I2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom

' Setting the different Sup = Supplier - CC = Cost Centre

Set Sup = Nothing
Set CC = Nothing
Set RC = Nothing
Set DelRg = Nothing
' Selects the first cell in the cost centre column

Range("H:H").Select

For Each Cell In Range("H:H")

' Sets active Cell = CC

CC = ActiveCell
Sup = ActiveCell.Offset(0, 1)


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

If ActiveCell.Value = CC And ActiveCell.Offset(0, 1).Value = Sup
Then
AddToUnion ActiveCell.Offset(0, 2)

' If Row is not equal to the one above then check if Total sum of
Range = 0

ElseIf Not Cell.Value = CC And Cell.Offset(0, 1).Value = Sup Then

' Check if Range is Nothing

If Not DelRg Is Nothing Then
DelRg.Select
DelRg.EntireColumn.Insert Shift:=xlToRight

ActiveCell.Offset(0, 4).Value = "=Sum(DelRg)"

If ActiveCell.Offset(0, 4).Value = 0 Then
DelRg.EntireRow.Delete Shift:=x1ToLeft



End If
End If

' Checks if the cell is blank if it is GoTo End

ElseIf IsEmpty(ActiveCell) Then GoTo TheEnd
End If

Next Cell

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


End Sub

Sub AddToUnion(Cell As Range)
Dim DelRg As Range
If DelRg Is Nothing Then
Set DelRg = Cell
Else
Set DelRg = Union(DelRg, Cell)
End If
End Sub


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

Can no one help me?


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