I want to run a macro to search through one workbook and find the
corresponding entry in another work book and enter the row details in
a new workbook if one of the other cells in the row does not match.

The real data I have is two product price lists.

So I want to be able to through through column A which has the product
code in the first worksheet and find the matching product code in the
second.

Once a match is found I want to check the corresponding row for Column
B which has the price. If there is any difference I want to have the
row from the first workbook copied and pasted into a new workbook.
This will give me a list of products that have a change in price.

Also if there is not a matching product code I want to also copy that
row into a third workbook on a different sheet. Plus reverse the
seach from the second workbook to the first. What this will do is
give me a list of new products and a list of old (obsolete) products.

Here is what I think I'm after in persudo code

WB1 = workbook1
WB1A = workbook1, column A
WB1B == workbook1, column B
WB2 = workbook2
WB1A = workbook2, column A
WB1B == workbook2, column B
WB3 = workbook3
WB3price_change = workbook3, worksheet 'price_change'
WB3new_product == workbook3, workshhet 'new_product'
WB3old_product == workbook3, workshhet 'old_product'



while WB1A is not empty
search WB1A
find matching row in WB2A
if WB1B = WB2B continue
if WB1B != WB2B
then copy row WB1A
Paste into WB3price_change
if WB1A finds no match in WB2A
then copy row WB1A
Paste into WB3new_product
goto start

while WB2A is not empty
search WB2A
find matching row in WB1A
if match found, continue
if WB2A finds no match in WB1A
then copy row WB2A
paste into WB3old_product
goto start

This code assumes all 3 workbooks are already open


Sub CheckPrices()
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet

Dim Ws1A As Range
Dim Ws2A As Range

Dim lWb1Row As Long
Dim lWb2Row As Long
Dim lws3VacRow As Long

Dim Cell As Range

Dim sProd As String

Set Ws1 = Workbooks("Book3").Sheets("Sheet1")
Set Ws2 = Workbooks("Book4").Sheets("Sheet1")
Set Ws3 = Workbooks("Book5").Sheets("Sheet1")

Set Ws1A = Ws1.Columns("A")
Set Ws2A = Ws2.Columns("A")

' compare book 1 against book 2
For Each Cell In Ws1.Range("A1:a" & Range("a65536").End(xlUp).Row)
lWb2Row = 0
If Not IsEmpty(Cell) Then
On Error Resume Next
lWb2Row = Ws2A.Find(What:=Cell.Value, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False).Row
On Error GoTo 0
If lWb2Row 0 Then
If Ws1.Range("b" & Cell.Row) < Ws2.Range("b" & lWb2Row)
Then
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
Else
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
End If
Next Cell

'compare book 2 against book 1
For Each Cell In Ws1.Range("A2:a" & Range("a65536").End(xlUp).Row)
lWb1Row = 0
If Not IsEmpty(Cell) Then
On Error Resume Next
lWb1Row = Ws2A.Find(What:=Cell.Value, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False).Row
On Error GoTo 0
If lWb1Row 0 Then
If Ws2.Range("b" & Cell.Row) < Ws1.Range("b" & lWb1Row)
Then
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
Else
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
End If

Next Cell

End Sub


---
Message posted from http://www.ExcelForum.com/

Thanks for the reply mudraker

I get an error when I run the macro and viewing the code in the VB
editor I see these offending parts in red

lWb2Row = Ws2A.Find(What:=Cell.Value, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False).Row

and


If Ws1.Range("b" & Cell.Row) < Ws2.Range("b" & lWb2Row)
Then


On Tue, 6 Jan 2004 00:32:36 -0600, mudraker
wrote:

This code assumes all 3 workbooks are already open


Sub CheckPrices()
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet

Dim Ws1A As Range
Dim Ws2A As Range

Dim lWb1Row As Long
Dim lWb2Row As Long
Dim lws3VacRow As Long

Dim Cell As Range

Dim sProd As String

Set Ws1 = Workbooks("Book3").Sheets("Sheet1")
Set Ws2 = Workbooks("Book4").Sheets("Sheet1")
Set Ws3 = Workbooks("Book5").Sheets("Sheet1")

Set Ws1A = Ws1.Columns("A")
Set Ws2A = Ws2.Columns("A")

' compare book 1 against book 2
For Each Cell In Ws1.Range("A1:a" & Range("a65536").End(xlUp).Row)
lWb2Row = 0
If Not IsEmpty(Cell) Then
On Error Resume Next
lWb2Row = Ws2A.Find(What:=Cell.Value, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False).Row
On Error GoTo 0
If lWb2Row 0 Then
If Ws1.Range("b" & Cell.Row) < Ws2.Range("b" & lWb2Row)
Then
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
Else
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
End If
Next Cell

'compare book 2 against book 1
For Each Cell In Ws1.Range("A2:a" & Range("a65536").End(xlUp).Row)
lWb1Row = 0
If Not IsEmpty(Cell) Then
On Error Resume Next
lWb1Row = Ws2A.Find(What:=Cell.Value, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False).Row
On Error GoTo 0
If lWb1Row 0 Then
If Ws2.Range("b" & Cell.Row) < Ws1.Range("b" & lWb1Row)
Then
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
Else
lws3VacRow = Ws3.Range("a65536").End(xlUp).Row + 1
Ws3.Range("a" & lws3VacRow).Value = Cell.Value
End If
End If

Next Cell

End Sub


---
Message posted from http://www.ExcelForum.com/

Direwolf


With the code that you pasted in this message It looks like my code has
been word wrapped at some stage.

When a _ is at the end of a line VBA joins the next line of code to
the previous to make up a continous single command



New code has _ added to 2 lines

lWb2Row = Ws2A.Find(What:=Cell.Value, After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Row


Put the Then at the end ot the If statment row

eg If(balh<blahblah) then


If Ws1.Range("b" & Cell.Row) < Ws2.Range("b" & lWb2Row)
Then


---
Message posted from http://www.ExcelForum.com/

ahhh now that makes sense.

As you can tell I don't know very much VB. I can do a bit of php so
I can relate that rule.

When I run the macro I get this error:
runtime error 9, subscript out of range

on this line of code:
Set Ws1 = Workbooks("book1").Sheets("Sheet1")

I'm assuming that it can't set the Ws1 variable as it has a problem
with the workbook?

I have my 3 workbooks (named - book1, book2, book3) open, the
worksheet in each is named "Sheet1". Do I need to define anything
else or is the problem with my workbooks?

Thanks for the help so far.



On Tue, 6 Jan 2004 16:26:52 -0600, mudraker
wrote:

Direwolf


With the code that you pasted in this message It looks like my code has
been word wrapped at some stage.

When a _ is at the end of a line VBA joins the next line of code to
the previous to make up a continous single command



New code has _ added to 2 lines

lWb2Row = Ws2A.Find(What:=Cell.Value, After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Row


Put the Then at the end ot the If statment row

eg If(balh<blahblah) then


If Ws1.Range("b" & Cell.Row) < Ws2.Range("b" & lWb2Row)
Then


---
Message posted from http://www.ExcelForum.com/

DireWolf

The workbook name will need to be set to the fulll workbook name eg
Book1.xls



Set Ws1 = Workbooks("book1").Sheets("Sheet1")
would work only if the workbook Book1 had never been saved once it has
been saved the workbookname becomes Book1.xls

try

Set Ws1 = Workbooks("book1.xls").Sheets("Sheet1")


---
Message posted from http://www.ExcelForum.com/