Hello Bob,

Another big thanks to you for your continued help. I made a couple of small
changes to your code, and its working fine. The version I am using is:

Function LastRow(sh As Worksheet, StartCell As Range)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=StartCell, _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet, StartCell As Range)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=StartCell, _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

Sub colourcells()
Dim cell As Range
Dim rng As Range

For Each cell In Worksheets("Details") _
.Range("K3", Cells(LastRow(Worksheets("Details"), Range("A1")), _
LastCol(Worksheets("Details"), Range("A1"))))

If Not cell.Value = "" Then 'Ignore Blank Cells
If cell.Value = "NAVL" Then 'Not Available is Grey Cell
with White Text
cell.Interior.ColorIndex = 15
cell.Font.ColorIndex = 2
Else
Set rng = Nothing
On Error Resume Next
Set rng =
Worksheets("Summary").Range("C2:C100").Find(cell.V alue)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
Else 'For Project Codes not found
colour cells Red
cell.Interior.ColorIndex = 3
End If
End If
End If
Next cell
End Sub

Sub clearcells()
Dim cell As Range
For Each cell In Worksheets("Details") _
.Range("K3", Cells(LastRow(Worksheets("Details"), Range("A1")), _
LastCol(Worksheets("Details"), Range("A1"))))

If Not cell.Value = "" Then 'Ignore Blank Cells
cell.Interior.ColorIndex = xlColorIndexNone
cell.Font.ColorIndex = xlAutomatic
End If
Next cell
End Sub

Thanks again, Chris

"Bob Phillips" wrote:

Hi again Chris,

Inline"ChrisO" wrote in message
...
Hi Bob,

I have a couple of supplementary questions this has thrown up:

1. My range in the Details sheet will always start at J3 but the table
could
grow so can you tell me if there is a way to identify the max row and
column,
and how I then use this in the range property?

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Details") _
.Range("J3", Cells(LastRow(Worksheets("Details"), Range("J3")), _
Lastcol(Worksheets("Details"), Range("J3"))))
If Not cell.Value = "" Then 'Ignore Blank Cells
If cell.Value = "NAVL" Then 'Not Available is Grey Cell
with White Text
cell.Interior.ColorIndex = 15
cell.Font.ColorIndex = 2
Else
Set rng = Nothing
On Error Resume Next
Worksheets("Summary").Range("F2:F100").Find (cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
End If
End If
Next cell
End Sub

Function LastRow(sh As Worksheet, StartCell As Range)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=StartCell, _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


2. I have noticed that after clearing the cell colouring the gridlines
seem
to disappear for the affected cells. Can you tell me why, and how to stop
this happening?

You are using the wrong constant to clear them. Change

cell.Interior.ColorIndex = xlAutomatic
to
cell.Interior.ColorIndex = xlColorindexNone