Comparing Wookbooks

[Chris Hankin]

Hello,

Could someone please help me refine the following VBA code to do the
following:

I am assuming that the two workbooks are open and that the code will
create a new workbook but does not save the new workbook.

The following code compares the "part numbers" (column A) in both
workbooks and copies the entire row when the part number does not match
into the new workbook.

Workbook1 Name: BookA
Worksheet1 Name: SheetA

and

Workbook2 Name: BookB
Worksheet2 Name: SheetB

Column A (in workbook: BookA.xls) contains a alpha-numerics and Column A
(in workbook: BookB.xls) also contains alpha-numerics. So, I need to
compare the values in columns A in both workbooks and where there is no
match, the entire row is to be copied to a new workbook. The range in
column A is from A2 to A65000.

I tried to rename CCC Part Numbers.xls to BookA.xls and I tried to
rename Current Part Numbers.xls to BookB.xls.

I also tried to rename worksheet CCC Part Numbers to SheetA (Workbook:
BookA.xls)
and tried to rename worksheet Current Part Numbers to SheetB (Workbook:
BookB.xls).

I simply kept on getting a series of errors.

Any help would be greatly appreciated,

Cheers,

Chris.

Sub comparebooks()

Set CCCPNum_bk = Workbooks("CCC Part Numbers.xls")
Set CCCPNum_sht = CCCPNum_bk.Sheets("CCC Part Numbers")

Set CurPNum_bk = Workbooks("Current Part Numbers.xls")
Set CurPNum_sht = CurPNum_bk.Sheets("Current Part Numbers")

Set newbk = Workbooks.Add
Set newbk_sht = newbk.Sheets("Sheet1")
NewbkRowCount = 1

With CCCPNum_sht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For CCCRowCount = 2 To LastRow
If .Range("A" & CCCRowCount) <> "" Then
CCCPNum = .Range("A" & CCCRowCount)
With CurPNum_sht
Set c = .Columns("A:A").Find(what:=CCCPNum, _
LookIn:=xlValues, lookat:=xlWhole)
End With

If c Is Nothing Then
.Rows(CCCRowCount).Copy _
Destination:=newbk_sht.Rows(NewbkRowCount)
NewbkRowCount = NewbkRowCount + 1
End If
End If
Next CCCRowCount
End With

End Sub

 

[Otto Moehrbach]

Chris
I take it that you want your search to be one-way only. That is, you
want to search WB2 for each item in WB1 and you don't want to ALSO search
WB1 for each item in WB2. Is that correct?
Your statement:
Set c = .Columns("A:A").Find(what:=CCCPNum, _
LookIn:=xlValues, lookat:=xlWhole)
will produce an error if the value is not found. Use an IF statement
instead, like:
If .Columns("A:A").Find(what:=CCCPNum, _
LookIn:=xlValues, lookat:=xlWhole) is Nothing Then
'do this if not found
End If

Your statement:
"I simply kept on getting a series of errors." is not very helpful. Be
specific. What error do you get? When you click on "Debug" what line of
code is highlighted? What did you do to troubleshoot the error and what did
you find? HTH Otto

 

[Chris Hankin]

Thanks Otto for your reply - greatly appreciated. After reading your
response, I agree that a two-way search is required.

Would it be possible (I'm a newbie) to modify my code for a two-way
search? If so, could you please modify the VBA code to do a two-way
search and include the name changes I need?

I really do thankyou for your help,

Kind regards,

Chris.

 

[Chris Hankin]

Oops, I forgot to mention that the VBA code was given to me by Joel (so
thanks Joel). If anyone can help me rename the workbooks and worksheets
that would be greatly appreciated. The existing VBA code does work
well.

Thanks,

Chris.

 

[Otto Moehrbach]

Chris
What do you want in this renaming the workbooks and worksheets? Again,
be specific. What do you mean when you say "The existing VBA code does
work well."? Did you mean NOT work well? What does it do or not do that
you want changed? I will work on it this morning. Otto

 

[Otto Moehrbach]

Chris
Try this code. I wrote it as 2 macros plus the declarations at the top.
Paste all of this code into a regular module. I didn't know into which file
you wanted to place this code so I wrote it to go into a third file. It
will work if you place it in one of the 2 files you have as well. I tested
this code but only somewhat since I don't have your files or data. Note
that the declarations at the top contain 2 constants for the path and file
name that you want to use for the new workbook. Replace what I have with
the path and name that you want to use.
I assumed that you wanted to copy 10 columns starting with Column A if the
value is not found. Change this as needed.
Try it out and if you get an error, note what the error says and note what
you did to create the error. Click on the Debug button of the error box and
note the line of code that is highlighted. HTH Otto
Option Explicit
Dim CCCPNum_bk As Workbook, CCCPNum_sht As Worksheet
Dim CurPNum_bk As Workbook, CurPNum_sht As Worksheet
Dim newbk As Workbook, newbk_sht As Worksheet
'Path to the new WB
Const ThePath = "C:\Whatever\TheFolder\"
'Name of new WB without the .xls extension
Const NewFileName = "TheFileName"
Dim rCCCColA As Range, rCurColA As Range
Dim i As Range, Dest As Range

Sub CompareBooks()
Call SetVariables
For Each i In rCCCColA
If Not IsEmpty(i.Value) Then
If rCurColA.Find(What:=i, LookIn:=xlValues, _
LookAt:=xlWhole) Is Nothing Then
i.Resize(, 10).Copy Dest
Set Dest = Dest.Offset(1)
End If
End If
Next i
For Each i In rCurColA
If Not IsEmpty(i.Value) Then
If rCCCColA.Find(What:=i, LookIn:=xlValues, _
LookAt:=xlWhole) Is Nothing Then
i.Resize(, 10).Copy Dest
Set Dest = Dest.Offset(1)
End If
End If
Next i
ActiveWorkbook.Save
ActiveWorkbook.Saved = True
End Sub

Sub SetVariables()
Set CCCPNum_bk = Workbooks("CCC Part Numbers.xls")
Set CCCPNum_sht = CCCPNum_bk.Sheets("CCC Part Numbers")
Set CurPNum_bk = Workbooks("Current Part Numbers.xls")
Set CurPNum_sht = CurPNum_bk.Sheets("Current Part Numbers")
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
ThePath & NewFileName & ".xls"
Set newbk = ActiveWorkbook
Set newbk_sht = newbk.Sheets("Sheet1")
Set Dest = newbk_sht.Range("A2")
'Note that the new WB is now the active WB
With CCCPNum_sht
Set rCCCColA = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
With CurPNum_sht
Set rCurColA = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
End Sub

 

[Chris Hankin]

Thanks for your help Otto - very much appreciated. Will try out your
new code and let you know how I went.

Cheers,

Chris.