Okay, firstly, please forgive the below code as, not having an
responses to these posts I've had to persevere myself which has led to
I'm sure, a pretty ugly and *******ised attempt.
However, it very nearly works now but I just need help with th
following which I still can't get to work:

Can anybody help me add an additional IF statement that is added, i
the value of thisrow = testrow is true? For example,

IF thisrow=testrow AND [same row as thisrow, column1].value = 'buy' AN
[same row as testrow, column1].value = 'sell' Then....

Currently it will work for the first match but then result in an objec
not defined error?

Please help, it's driving me mad!!!

Regards,

Adrian




Dim LastRow As Integer
Dim TestRow As Variant
Dim ReturnCell As Range
Dim firstrow As Range
Dim TestRange As Range
Dim ThisRange As Range
' Go to start of data range, get last row number and set first
' return marker

ActiveSheet.Range("A2").Select
LastRow = ActiveCell.End(xlDown).Row
Set ReturnCell = ActiveCell.Offset(-1, 0)

' Begin overall loop
For Row = 2 To LastRow

' Exit loop if next row is blank
If ActiveCell.Offset(1, 0) = " " Then Exit Sub

' Concatenate current row and capture address of ActiveCell
Set TestRange = ActiveCell
TestRow = ActiveCell.Offset(0, 5).Text & ActiveCell.Offset(0
9).Text _
& ActiveCell.Offset(0, 11).Text

'Set firstrow = ActiveCell.EntireRow

' Move to next row to begin testing for duplicates
ActiveCell.Offset(1, 0).Select

' Loop through remaining rows and delete duplicates of current row
For testrows = ActiveCell.Row To LastRow

' Concatenate current row
thisrow = ActiveCell.Offset(0, 5).Text _
& ActiveCell.Offset(0, 9).Text & ActiveCell.Offset(0, 11).Text
Set ThisRange = ActiveCell
' Compare value of current row against TestRow
' and delete row if same
If thisrow = TestRow Then ' And TestRange.Offset(0, 3).Value
"sell" And
'ThisRange.Offset(0, 3) = "buy" Then
'thisrow.EntireRow.Select 'Delete shift:=xlUp
TestRange.EntireRow.Interior.Color = vbYellow
ThisRange.EntireRow.Interior.Color = vbBlue
'firstrow.EntireRow.Delete Shift:=xlUp
Set ReturnCell = ReturnCell.Offset(-1, 0)
ThisRange.EntireRow.Delete Shift:=xlUp
TestRange.EntireRow.Delete Shift:=xlUp
LastRow = LastRow - 2

' If not equal, move to next row
Else: ActiveCell.Offset(1, 0).Select
End If

Next

' Go back to ReturnCell, advance to next row, reset ReturnCell
ReturnCell.Select
ActiveCell.Offset(1, 0).Select
Set ReturnCell = ActiveCell

Next

End Su

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com