Two-way data comparison help please

[Chris Hankin]

Hello, could someone please help with the following?

I wish to undertake a two-way data comparison as follows:

Workbook1 Name: CCC Part Numbers.xls
Worksheet1 Name: CCC Part Numbers

and

Workbook2 Name: Current Part Numbers.xls
Worksheet1 Name: Current Part Numbers


Column A ( in Workbook: CCC Part Numbers.xls) contains a list of 5500
part numbers - for example:

Cell A2: 001-PL-77RFC
Cell A3: A-56KL-001
Cell A4: 0029-YYTF-5578
Cell A5: GGF002-96PMC-05
Cell A6: 6003-JHQ
Cell A7: Z-PUNR-74100

Column A (in Workbook: Current Part Numbers.xls) also contains a list of
500 part numbers - for example:

Cell A2: A85-KLM
Cell A3: A-56KL-001
Cell A4: 0029-YYTF-5578
Cell A5: H005-TYB-417
Cell A6: 6003-JHQ
Cell A7: Y001-9874185-964

Both workbooks are identical in layout and structure as follows:

Column C contains the associated Item Names for the part numbers listed
in column A.

Column D contains the associated Supplier Codes for the part numbers
listed in column A.

Column E contains the associated Codified Product Numbers for the part
numbers listed in column A.

Column F contains the associated Unit of Measures for the part numbers
listed in column A.

Column G contains the associated Costs for the part numbers listed in
column A.

Column H contains the associated Storage Locations for the part numbers
listed in column A.

Column I contains the associated Product Types for the part numbers
listed in column A.

I need to compare the data in column A of (Workbook: CCC Part
Numbers.xls) against the data in column A of (Workbook: Current Part
Numbers.xls) and all those values in column A of (Workbook: CCC Part
Numbers.xls) that do not match a value in column A of (Workbook:
Current Part Numbers.xls) need to be copied to a new (Workbook named:
Matched Data) and the associated values in columns C to columns I need
to be copied to this new workbook.

Any help would be greatly appreciated,

Kind regards,

Chris.



*** Sent via Developersdex http://www.developersdex.com ***

 

[Joel]

The code expects the two workbooks to be opened. Will create a newworkbook,
but doesn't save the new book. I copied the entire row when the part number
did not match. If you need additional changes let me know.




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
CCCRowCount = 1
Do While .Range("A" & CCCRowCount) <> ""
CCCPNum = .Range("A" & CCCRowCount)
With CurPNum_sht
Set c = .Columns("A:A").Find(what:=CCCPNum, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
c.EntireRow.Copy _
Destination:=newbk_sht.Rows(NewbkRowCount)
NewbkRowCount = NewbkRowCount + 1
End If
End With
CCCRowCount = CCCRowCount + 1
Loop
End With

End Sub

 

[Chris Hankin]

Thanks Joel for all your help - very much appreciated. I am however
encountering a Run Time Error '91' - Object variable or With block
variable not set. This occurs at the following line of code:

c.EntireRow.Copy _
Destination:=newbk_sht.Rows(NewbkRowCount)

Could you please advise on how to set the Object variable or With block
variable?


Kind regards,

Chris.

*** Sent via Developersdex http://www.developersdex.com ***

 

[dan dungan]

Hi Chris

It may be that you are using option explicit and some variable(s) are
not dimensioned.

Dan

 

[Chris Hankin]

Hi Dan - thanks for your reply - greatly appreciated. I am using the
above VBA code in an Excel Module. I copied 'n' pasted the above VBA
code directly into the Module. The error seems to indicate that maybe I
need to set an Object variable or With Block variable?

Could you please refer to the VBA code and advise if it needs to be
further dimentioned or maybe set an Object variable or With Block
variable?

Thanks,

Chris.

*** Sent via Developersdex http://www.developersdex.com ***

 

[dan dungan]

Hi Chris,

In the excel module do you see the words "option explicit" at the top
of the coding area? If so, all the variables need to be declared.

I don't have extra time right now to go through it, and I'm not sure
that's your problem.

I'll look at it tomorrow. Maybe someone else will have better feedback
sooner.

Dan

 

[Chris Hankin]

Hi Dan,

Please be advised that I do not see the words "option explicit" at the
top of my Excel Module.

Any help is greatly appreciated.

Thanks,

Chris.




*** Sent via Developersdex http://www.developersdex.com ***

 

[Chris Hankin]

Hi Joel,

Could you please modify your code so that the range on column A starts
from A2 to A65000 in (Workbook: CCC Part Numbers.xls) and compares the
data against column A in (Workbook: Current Part Numbers.xls)? Column A
in (Workbook: Current Part Numbers.xls) has a range of A2 to A65000.

Also, still encountering a Run Time Error '91' - Object variable or With
block variable not set. This occurs at the following line of code:

c.EntireRow.Copy _
Destination:=newbk_sht.Rows(NewbkRowCount)

Your help is much appreciated,

thanks,

Chris.



*** Sent via Developersdex http://www.developersdex.com ***

 

[Joel]

I made some minor changes. This should work. Not should, but will work.


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

 

[Chris Hankin]

Thanks again Joel - your help is very much appreciated.

Cheers,

Chris.



*** Sent via Developersdex http://www.developersdex.com ***