C
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
*** Sent via Developersdex http://www.developersdex.com ***
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
*** Sent via Developersdex http://www.developersdex.com ***