Hi all,

Can someone please tell me if its possible to create a program that will
somehow colour cells in one workbook that match cells in another
workbook? For exmaple, if a cell had, say 'IBM' in one workbook and IBM
in a cell in another workbook then colour that cell (or any other way of
letting me know when there is a match)

As always I really appreciate your help.

Cheers



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

Hi Carlton,

Assuming that the values in the first workbook are not thr result of
formulas, try the following. If the values are the result of formulas, post
back for revised code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WB As Workbook
Dim SH As Worksheet
Dim rCell As Range
Set WB = Workbooks("BOOK2.xls") '<<===== CHANGE
Dim rng As Range
Dim RngFound As Range

Set rng = Intersect(Target, Range("A1:A10")) '<<===== CHANGE

If Not rng Is Nothing Then
For Each rCell In rng
If Not IsEmpty(rCell) Then
For Each SH In WB.Worksheets
Set RngFound = SH.Cells.Find( _
what:=rCell.Value, _
After:=SH.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not RngFound Is Nothing Then
rCell.Interior.ColorIndex = 37
Exit For
End If
Next SH
End If
If RngFound Is Nothing Then rCell.Interior. _
ColorIndex = xlNone
Next rCell
End If
End Sub

Change the name of the second workbook; change the range to be colored on
the active sheet.

This is worksheet event code, so it needs to be placed in the worksheet's
code module, not in a standard module or the ThisWorkbook module.

Copy the code, right-click the worksheet tab and paste the code. Alt-F11 to
return to the worksheet.

---
Regards,
Norman



"Carlton Patterson" wrote in message
...
Hi all,

Can someone please tell me if its possible to create a program that will
somehow colour cells in one workbook that match cells in another
workbook? For exmaple, if a cell had, say 'IBM' in one workbook and IBM
in a cell in another workbook then colour that cell (or any other way of
letting me know when there is a match)

As always I really appreciate your help.

Cheers



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

Hi Norman,

This appears to be what I need. Is there a way to get it to run like a
regular macro? By 'run like a regular macro' I mean by running it like a
standard macro? At the moment it runs by opening up the worksheet.

Cheers mate

Carlton

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

Hi Carlton,

Is there a way to get it to run like a regular macro

Sure. From previous posts by you I incorrectly assumed you were lookiing to
have the cells colored dynamically. My error - apologies.

Try the following (in a standard module):

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim RngFound As Range

Set WB = Workbooks("BOOK2.xls") '<<===== CHANGE

Set rng = Range("A1:A10") '<<===== CHANGE

Application.ScreenUpdating = False

For Each rCell In rng
If Not IsEmpty(rCell) Then
For Each SH In WB.Worksheets
Set RngFound = SH.Cells.Find( _
what:=rCell.Value, _
After:=SH.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not RngFound Is Nothing Then
rCell.Interior.ColorIndex = 37
Exit For
End If
Next SH
End If
If RngFound Is Nothing Then rCell.Interior. _
ColorIndex = xlNone
Next rCell

Application.ScreenUpdating = True

End Sub


---
Regards,
Norman



"Carlton Patterson" wrote in message
...
Hi Norman,

This appears to be what I need. Is there a way to get it to run like a
regular macro? By 'run like a regular macro' I mean by running it like a
standard macro? At the moment it runs by opening up the worksheet.

Cheers mate

Carlton

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

Hi Norman,

Its working a treat.

Thanks a lot mate.

Cheers

Carlton


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

Hi Carlton,

Good to hear, but see my later post for a suggested solution for your
subsequent multiple workbook lookups request.

Note that all the relevant workbooks must be open. As written, there is no
error handling to deal with closed/missing books.

---
Regards,
Norman



"Carlton Patterson" wrote in message
...
Hi Norman,

Its working a treat.

Thanks a lot mate.

Cheers

Carlton


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

Also,

Is it possible to add more than workbook. At the moment the program
includes one book:

Set WB = Workbooks("BOOK2.xls")


However, could I change the formula to include a few workbooks?

Cheers

Carlton


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

Hi Carlton,

Is it possible to add more than workbook. At the moment the program
includes one book:

Try:

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim RngFound As Range
Dim arr As Variant
Dim i As Long

arr = Array("Book2.xls", "Book3.xls", "Book4.xls") '<<= CHANGE

Set rng = Range("A1:A10") '<<===== CHANGE

Application.ScreenUpdating = False

rng.Interior.ColorIndex = xlNone

For i = LBound(arr) To UBound(arr)
Set WB = Workbooks(arr(i))
For Each rCell In rng
If Not IsEmpty(rCell) Then
For Each SH In WB.Worksheets
Set RngFound = SH.Cells.Find( _
what:=rCell.Value, _
After:=SH.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not RngFound Is Nothing Then
rCell.Interior.ColorIndex = 37
BlFound = True
Exit For
End If
Next SH
End If
Next rCell
Next i

Application.ScreenUpdating = True

End Sub


---
Regards,
Norman



"Carlton Patterson" wrote in message
...
Also,

Is it possible to add more than workbook. At the moment the program
includes one book:

Set WB = Workbooks("BOOK2.xls")


However, could I change the formula to include a few workbooks?

Cheers

Carlton


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

Hi Carlton,

The line:

BlFound = True

Is extraneous and may be deleted.


---
Regards,
Norman



"Norman Jones" wrote in message
...
Hi Carlton,

Is it possible to add more than workbook. At the moment the program
includes one book:

Try:

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim RngFound As Range
Dim arr As Variant
Dim i As Long

arr = Array("Book2.xls", "Book3.xls", "Book4.xls") '<<= CHANGE

Set rng = Range("A1:A10") '<<===== CHANGE

Application.ScreenUpdating = False

rng.Interior.ColorIndex = xlNone

For i = LBound(arr) To UBound(arr)
Set WB = Workbooks(arr(i))
For Each rCell In rng
If Not IsEmpty(rCell) Then
For Each SH In WB.Worksheets
Set RngFound = SH.Cells.Find( _
what:=rCell.Value, _
After:=SH.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not RngFound Is Nothing Then
rCell.Interior.ColorIndex = 37
BlFound = True
Exit For
End If
Next SH
End If
Next rCell
Next i

Application.ScreenUpdating = True

End Sub


---
Regards,
Norman