Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
counting matching multiple entries colensa Excel Discussion (Misc queries) 2 May 17th 09 09:11 PM
Matching List Entries steev_jd Excel Discussion (Misc queries) 3 April 6th 06 03:11 PM
Matching and Copying entries Box666 Excel Discussion (Misc queries) 1 January 9th 06 09:45 PM
Help matching entries in two sheets??? Curalice Excel Worksheet Functions 2 November 12th 05 07:53 PM
matching column entries billytf Excel Worksheet Functions 6 April 11th 05 06:41 AM


All times are GMT +1. The time now is 04:00 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"