Remove opposite/almost matching entries?

  • Thread starter Thread starter Kobayashi
  • Start date Start date
K

Kobayashi

I have a s/sheet containing multiple columns. However, one of these
columns contains only two criteria; 'buy' and 'sell'. Another column
contains a ref. no..
What I need to do is look up each row and, for each ref. no., if the
value in the buy/sell column is 'buy' then I need to see if there is a
similar entry in another row, ensuring that three other column values
(including the ref. no. column) also match, with a 'sell' value?
Hope this makes sense?

I've been looking at the index and match functions and feel that these
will probably be able to do what I need but unfortunately my limited
experience prevents me from going any further.

Therefore, any help is very much appreciated.

Regards,

Adrian
 
Can you sort the sheet so that the buy and sell rows are
next to each other ? Then in an additional column use a
formula to compare - if bus/sell column ='sell' then are
the values in the preceeding row equal to this row and
a 'buy' value.
With an if stament you could give a result of 1 ir true or
0 if false and then sum the column to show the number of
matches - or just look for a 1 in the new column.
 
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
 
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 bastardised 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
 
Back
Top