PDA

View Full Version : Deleting identical rows between sheets?



wakingedge42
07-07-2007, 10:56 AM
Hi all, I'm trying to create an Excel macro that automatically deletes any rows in Worksheet1 that are also on Worksheet2. Individual cells that match on both sheets don't matter, all that matters is if entire rows match between sheets. Could anyone help me with the code? I'm having a lot of trouble with it

mdmackillop
07-07-2007, 11:37 AM
Hi,
Welcome to VBAX
Can you post your workbook and your code to date. Use Manage Attachments in the Go Advanced section
Regards
MD

Ken Puls
07-07-2007, 02:16 PM
Interesting quandry. Curious, MD, have you given though to how to approach it yet?

Depending on how many columns of data there are, I would probably do something like the following:
-Apply a formula to Sheets 1 & 2 like =A1&B1&C1&D1...
-Apply a formula to Sheet 2 that does a vlookup of Sheet2 against Sheet1 and returning True if found and False if not
-Sort the list by the lookup column (to avoid contiguous range issues later)
-Filter the list on Sheet 2 to show only the True values (duplicates) and delete them
-Remove the helper columns

Of course... seeing the data might change that opinion. ;)

mdmackillop
07-07-2007, 02:22 PM
Hi Ken,
I was hoping for real data to test it on. My tentative solution is to search for initial values, check for range lengths/ number of data cells, and if these are the same, an item by item comparison.
Might be a bit slow for large numbers though.

Option Explicit
Sub Check()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Rw1 As Long, i As Long
Dim FirstAddress As String
Dim a As Range, c As Range

'Create a variable reference to the relevant worksheets
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
'Find the last used row on sheet 1
Rw1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Row

'Step through the cells in Sheet 1 column A, starting from the bottom
For i = Rw1 To 1 Step -1
'Search for the value in sheet 2; find all occurences
With ws2.Columns(1)
Set a = Cells(i, 1)
Set c = .Find(a, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
'When value found, pass cell references to function for comparison
If CompareCells(a, c) = True Then
'If identical, then delete Sheet 1 row
a.EntireRow.Delete
'Exit and go to next cell in Column A
Exit Do
End If
Set c = .FindNext(c)
'Find next value until first cell is found again
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With

Next
End Sub

Function CompareCells(a As Range, c As Range) As Boolean
'Create variables to refer to corresponding rows
Dim aa As Range, cc As Range
Dim i As Long
'Set initial value to True
CompareCells = True
'Create range of used cells in row on Sheet 1
Set aa = Range(a, Cells(a.Row, Columns.Count).End(xlToLeft))
'Create range of used cells in row on Sheet 2
With Sheets(2)
Set cc = Range(c, .Cells(c.Row, Columns.Count).End(xlToLeft))
End With
'In the number of cells differ or filled cells differ then Compare = False
With Application.WorksheetFunction
If .CountA(aa) <> .CountA(cc) Or _
aa.Cells.Count <> cc.Cells.Count Then
'Return value and exit function
CompareCells = False
Exit Function
End If
End With
'Compare both ranges cell by cell
For i = 1 To aa.Cells.Count
'If compare fails then Compare = False; exit function
If aa(i) <> cc(i) Then
CompareCells = False
Exit Function
End If
Next
End Function

lucas
07-07-2007, 02:58 PM
Don't know if this will help and I don't remember where I got it...have had it since before I was a member here. Code is not protected.

I use it to find differences in sheets..maybe you can get some ideas from it.

mikerickson
07-07-2007, 04:37 PM
If the top lines of each sheet are the same (like a header row). This will delete any rows on sheet1 that are duplicated on sheet2. (It deletes that duplicated top row on sheet1 only.)
Sheets("sheet1").UsedRange.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Sheets("sheet2").UsedRange, _
Unique:=False
Sheets("sheet1").SpecialCells(xlCellTypeVisible).Delete

Ken Puls
07-08-2007, 09:56 AM
Well now, that is a nice approach! :)

mdmackillop
07-08-2007, 11:16 AM
Well now, that is a nice approach! :)
Agreed, but I can't get it to work with large amounts of data (5000 rows x 6 columns)

wakingedge42
07-08-2007, 06:58 PM
mdmackillop, your code works great for me, thank you very much.

Also, I am pretty new to VBA and am eager to gain a better understanding of it. If you have a few minutes, I would really appreciate if you could explain to me in layman's terms what your code means and what it's doing exactly. Thanks!

mdmackillop
07-09-2007, 05:56 AM
mdmackillop, your code works great for me, thank you very much.

Also, I am pretty new to VBA and am eager to gain a better understanding of it. If you have a few minutes, I would really appreciate if you could explain to me in layman's terms what your code means and what it's doing exactly. Thanks!
I've added comments to my previous post.

wakingedge42
07-09-2007, 07:01 PM
mdmackillop, thanks a lot for the comments, they are very helpful.

but some bad news: i tried your macro with my financial reports (which i can't post unfortunately because they contain confidential info.) and it didn't work. my reports are about 50 rows x 16 columns. apparently your code works great for a small data set, but for lots of data, it doesn't work at all. got any ideas on how to fix this?

mdmackillop
07-10-2007, 12:36 AM
Deleting too much or nothing at all? You'll need to test on known data/results and then step through problem lines to track down the error. The code logic is pretty simple.

Try adding some colour eg
If aa(i) <> cc(i) Then
CompareCells = False
aa(i).interior.colorindex = 6
Exit Function
End If
Use this to check equal or nonequal values