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/