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" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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.
>
>
>
> *** Sent via Developersdex http://www.developersdex.com ***
Similar Threads
