Compare 2 workbooks and delete duplicates

[ckelley1020]

I have two workbooks with 1 worksheet each.

workbook 1 has 20 columns.
Workbook 2 has 20 columns as well.

I want to see if the first 5 columns in wkbk1 match any of the first 5 columns in wkbk2. If they do I want to delete the entry in workbook2

Thanks for any help you can give me.

[Chabu]

try this
Option Explicit


Public Sub compareColumns()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim asheet1 As Worksheet
Dim asheet2 As Worksheet
Set asheet1 = wb.Worksheets("1")
Set asheet2 = wb.Worksheets("2")
Dim aCell As Range
Dim somecells As Range
Dim same As Boolean
same = False
Dim sourceCol, targetCol As Long
On Error Resume Next
For sourceCol = 1 To 5
Set somecells = asheet1.Columns(sourceCol).SpecialCells(xlCellTypeConstants)
If Err.Number = 0 Then
For targetCol = 1 To 5
For Each aCell In asheet1.Columns(sourceCol).SpecialCells(xlCellTypeConstants)
If aCell.Value = asheet2.Cells(aCell.Row, targetCol).Value Then
same = True
Else
same = False
Exit For
End If
Next aCell
If same Then
For Each aCell In asheet2.Columns(targetCol).SpecialCells(xlCellTypeConstants)
If aCell.Value <> asheet1.Cells(aCell.Row, sourceCol).Value Then
same = False
Exit For
End If
Next aCell
If same Then
Debug.Print "column " & sourceCol & " matches column " & targetCol
'uncomment next line to clear matched column
'asheet2.Columns(targetCol).Clear
End If

Else
Debug.Print "No match for " & sourceCol & " with column " & targetCol
End If
Next targetCol
Else
Debug.Print sourceCol & " empty"
End If
Next sourceCol
End Sub

Greetings

[ckelley1020]

Chabu, I tried that and it didnt work. I changed the Woeksheet 1 and 2 to read Sheet 1 and 2 to reflect putting all data into 1 workbook, after getting a subscript out of range. Neither works and the data still shows as it did when first run. Any ideas?

[ckelley1020]

Chabu, This might help to see the data and what I am looking to have happen.

WKBK1 (Sheet1)

01/01/2009 01/01/2010 ABC Company 1234 Main Street Washington DC
01/01/2009 01/01/2010 BAC Company 12 Brown Street Washington DC
10/03/2009 10/03/2010 B&A INC 470 Black Street Washington DC

WKBK2 (Sheet 1)

01/01/2009 01/01/2010 ABC Company 1234 Main Street Washington DC
01/01/2009 01/01/2010 ARMS LLC 372 White Street Washington DC
10/03/2009 10/03/2010 B&A INC 470 Black Street Washington DC

In this data set, item 1 and 3 are the same in both WKBK1 and WKBK2 and should be deleted from WKBK2.

WKBK2 (after) (Sheet 1)
01/01/2009 01/01/2010 ARMS LLC 372 White Street Washington DC


:hi:

[shrivallabha]

Paste the code below in your WKBK1 and see if it works as you desire. Modify code at the commented places and then test it.
Option Explicit
Dim wb2 As Workbook
Dim s1 As String, s2 As String
Dim lRow1 As Long, lRow2 As Long
Dim i As Integer, j As Integer
Public Sub DeleteDuplicates()
'Checking if second workbook is open then macro won't proceed
If bIsWorkBookOpen("WKBK2.xls") = False Then 'Change WKBK2.xls i.e. Second Workbook to suit
MsgBox "Second WorkBook Is Not Open!!!" & vbCr & _
"Open It and then Rerun this macro!!!"
Exit Sub
Else
'Avoiding screen flicker
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb2 = Workbooks("WKBK2.xls") 'Change WKBK2.xls i.e. Second Workbook to suit
lRow1 = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lRow1 'Considering 1st row as header row. Change to suit
s1 = Range("A" & i).Value2 & Range("B" & i).Value2 & Range("C" & i).Value2 & _
Range("D" & i).Value2 & Range("E" & i).Value2
lRow2 = wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For j = lRow2 To 2 Step -1 'Considering 1st row as header row. Change to suit
s2 = wb2.Sheets(1).Range("A" & j).Value2 & _
wb2.Sheets(1).Range("B" & j).Value2 & _
wb2.Sheets(1).Range("C" & j).Value2 & _
wb2.Sheets(1).Range("D" & j).Value2 & _
wb2.Sheets(1).Range("E" & j).Value2
If s1 = s2 Then
wb2.Sheets(1).Rows(j).Delete
End If
Next j

Next i
'Resetting to Excel Defaults
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub
Public Function bIsWorkBookOpen(sWBName As String) As Boolean
'Thanks to Excel 2007 VBA Programmer's Reference / Chapter 3
On Error Resume Next
Set wb2 = Workbooks(sWBName)
If Not wb2 Is Nothing Then
bIsWorkBookOpen = True
End If
End Function

[ckelley1020]

I just am having an issue with this one line of code:

lRow2 = wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

If I give a value of say 6, it works fine, but can't generate the correct count from
the second workbook.

Any idea what it might be? Thanks for your help on this.

:bow:

[shrivallabha]

I think it is shooting in the dark unless there's some sample (actual with sensitive info removed) workbook, especially to see the formatting part. Can you post it?

[ckelley1020]

this is stripped down data and it still doesn't work. If I populate the value manually, it works fine.

[shrivallabha]

There was a problem in the logic. All entries from your workbook2 should have been deleted. It was leaving you with two rows. Right? I think I have addressed this in the current case (check the red marked part):
Option Explicit
Dim wb2 As Workbook
Dim s1 As String, s2 As String
Dim lRow1 As Long, lRow2 As Long
Dim i As Integer, j As Integer
Public Sub DeleteDuplicates()
'Checking if second workbook is open then macro won't proceed
If bIsWorkBookOpen("WKBK2.xls") = False Then 'Change WKBK2.xls i.e. Second Workbook to suit
MsgBox "Second WorkBook Is Not Open!!!" & vbCr & _
"Open It and then Rerun this macro!!!"
Exit Sub
Else
'Avoiding screen flicker
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb2 = Workbooks("WKBK2.xls") 'Change WKBK2.xls i.e. Second Workbook to suit
lRow1 = Range("A" & Rows.Count).End(xlUp).Row

For i = lRow1 To 2 Step -1 'Considering 1st row as header row. Change to suit
s1 = Range("A" & i).Value2 & Range("B" & i).Value2 & Range("C" & i).Value2 & _
Range("D" & i).Value2 & Range("E" & i).Value2 & Range("F" & i).Value2 & Range("G" & i).Value2

lRow2 = wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For j = lRow2 To 2 Step -1 'Considering 1st row as header row. Change to suit
s2 = wb2.Sheets(1).Range("A" & j).Value2 & _
wb2.Sheets(1).Range("B" & j).Value2 & _
wb2.Sheets(1).Range("C" & j).Value2 & _
wb2.Sheets(1).Range("D" & j).Value2 & _
wb2.Sheets(1).Range("E" & j).Value2 & _
wb2.Sheets(1).Range("F" & j).Value2 & _
wb2.Sheets(1).Range("G" & j).Value2
If s1 = s2 Then
wb2.Sheets(1).Rows(j).Delete
End If
Next j

Next i
'Resetting to Excel Defaults
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
End Sub
Public Function bIsWorkBookOpen(sWBName As String) As Boolean
'Thanks to Excel 2007 VBA Programmer's Reference / Chapter 3
On Error Resume Next
Set wb2 = Workbooks(sWBName)
If Not wb2 Is Nothing Then
bIsWorkBookOpen = True
End If
End Function

The problem was : the integer i would keep progressing forward so it'd jump the queue and miss few entries on the road.

[ckelley1020]

The code does work if I manually tell it how many rows are in WKBK2. It leaves two entries because that should be what happens, and deletes all the dups it finds in wkbk1 and wkbk2. So that all works except for this line below.
If I comment out the first line and use the second line, all works.

lRow2 = wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

lRow2 = 6 WOrKS with manual count

So what isn't working is the ability for the macro to go to wkbk2 and count the number of rows with data in column A and return that value for use.

[shrivallabha]

I should have tested it more. I did not care / bother / notice (:banghead: ) the difference in versions. The following line should work:
lRow2 = wb2.Sheets(1).Range("A65536").End(xlUp).Row
The rows.count is different for both versions.

And if this works, then I have a question for you:
Can you not keep both workbook-versions the same i.e. either 2003 or 2007+? And change lines like this to:
Set wb2 = Workbooks("WKBK2.xlsx")

[ckelley1020]

That did it. You are the man! I will double check and make sure the two workbooks are either XLS or XLSX and use the correct code accordingly.

Thanks for the help on this!:friends:


P.S. I'll change this to solved in IE in a few minutes.