View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Kobayashi[_22_] Kobayashi[_22_] is offline
external usenet poster
 
Posts: 1
Default Remove opposite/almost matching entries?


No response to my original request, perhaps it was too vague, but
don't seem to be getting any responses to my last few posts so if I'
doing something wrong or not adhering to posting etiquette then pleas
let me know?
Anyhow, after a lot more hunting around I have found the followin
code, created by J.Hunt in 1997 which seems to ALMOST do what I need.
However, how can I amend it so that both the matching row 'this row
and the original row 'testrow' get deleted, as opposed to just th
duplicated 'thisrow'?
Further, I also need this to only happen IF the value in an additiona
column is 'buy' for one and 'sell' for the other, or vice-versa, bu
not both 'buy's or both 'sells'?

Many thanks,

Adrian

Sub DeleteDuplicates()

Dim LastRow As Integer
Dim TestRow As Variant
Dim ReturnCell 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

' 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
TestRow = ActiveCell.Text & ActiveCell.Offset(0, 1).Text & _
ActiveCell.Offset(0, 2).Text & ActiveCell.Offset(0, 3).Text

' 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.Text & ActiveCell.Offset(0, 1).Text _
& ActiveCell.Offset(0, 2).Text & ActiveCell.Offset(0, 3).Text

' Compare value of current row against TestRow
' and delete row if same
If ThisRow = TestRow Then
Selection.EntireRow.Delete Shift:=xlUp
LastRow = LastRow - 1

' 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