Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains unique 4
character text codes, e.g. ABXY, each cell is coloured manually by the user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character codes.
- I would like to colour the cells in sheet 1 to the same colour as the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with, so I'd be
very grateful for your help and suggestions.

Thanks, Chris

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets("Sheet2").Cells.Find(cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
Next cell
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains unique 4
character text codes, e.g. ABXY, each cell is coloured manually by the
user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character codes.
- I would like to colour the cells in sheet 1 to the same colour as the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with, so I'd be
very grateful for your help and suggestions.

Thanks, Chris

Bob,

Many thanks for your reply. I'm afraid I'm a complete novice when it comes
to macros and VBA, so can you tell me:

- how do I "install" this code?
- are the names "sheet1" and "sheet2" in the code the name on the sheet tabs
or the sheet numbers
- how do I specify the range of cells to lookup in sheet 2 and update in
sheet 1 to limit this to certain areas in each sheet?
- how do I run it?

Thanks again, Chris

"Bob Phillips" wrote:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets("Sheet2").Cells.Find(cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
Next cell
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains unique 4
character text codes, e.g. ABXY, each cell is coloured manually by the
user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character codes.
- I would like to colour the cells in sheet 1 to the same colour as the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with, so I'd be
very grateful for your help and suggestions.

Thanks, Chris

"ChrisO" wrote in message
...
Bob,

Many thanks for your reply. I'm afraid I'm a complete novice when it comes
to macros and VBA, so can you tell me:

- how do I "install" this code?

Go to the VBIDE (Alt-F11)
Menu InsertModule
Copy the code in

- are the names "sheet1" and "sheet2" in the code the name on the sheet
tabs
or the sheet numbers

names on the tabs

- how do I specify the range of cells to lookup in sheet 2 and update in
sheet 1 to limit this to certain areas in each sheet?

The range to update, change UsedRange to Range("H1:M10") or whatever is
appropriate

It looks up all cells on sheet2, so don't change anything here

- how do I run it?

In Excel, menu ToolsMacroMacros... select the name from the list, and
click Run

Mnay thanks Bob. Here is the final version I am now using:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Details").Range("J3:V74")
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("F2:F100").Find(cell.V alue)
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

Sub clearcells()
Dim cell As Range
For Each cell In Worksheets("Details").Range("J3:V74")
cell.Interior.ColorIndex = xlAutomatic
Next cell
End Sub

Run via 2 command buttons - one to set the colours, the other to clear them.

Chris

"Bob Phillips" wrote:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets("Sheet2").Cells.Find(cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
Next cell
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains unique 4
character text codes, e.g. ABXY, each cell is coloured manually by the
user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character codes.
- I would like to colour the cells in sheet 1 to the same colour as the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with, so I'd be
very grateful for your help and suggestions.

Thanks, Chris

And that is working fine is it?

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Mnay thanks Bob. Here is the final version I am now using:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Details").Range("J3:V74")
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("F2:F100").Find(cell.V alue)
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

Sub clearcells()
Dim cell As Range
For Each cell In Worksheets("Details").Range("J3:V74")
cell.Interior.ColorIndex = xlAutomatic
Next cell
End Sub

Run via 2 command buttons - one to set the colours, the other to clear
them.

Chris

"Bob Phillips" wrote:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets("Sheet2").Cells.Find(cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
Next cell
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains unique 4
character text codes, e.g. ABXY, each cell is coloured manually by the
user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character
codes.
- I would like to colour the cells in sheet 1 to the same colour as
the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with, so
I'd be
very grateful for your help and suggestions.

Thanks, Chris

Bob,

Yes, this seems to be doing exactly what I wanted, so thanks again for your
help.

Chris

"Bob Phillips" wrote:

And that is working fine is it?

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Mnay thanks Bob. Here is the final version I am now using:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Details").Range("J3:V74")
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("F2:F100").Find(cell.V alue)
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

Sub clearcells()
Dim cell As Range
For Each cell In Worksheets("Details").Range("J3:V74")
cell.Interior.ColorIndex = xlAutomatic
Next cell
End Sub

Run via 2 command buttons - one to set the colours, the other to clear
them.

Chris

"Bob Phillips" wrote:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets("Sheet2").Cells.Find(cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
Next cell
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains unique 4
character text codes, e.g. ABXY, each cell is coloured manually by the
user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character
codes.
- I would like to colour the cells in sheet 1 to the same colour as
the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with, so
I'd be
very grateful for your help and suggestions.

Thanks, Chris

Excellent.

Regards

Bob

"ChrisO" wrote in message
...
Bob,

Yes, this seems to be doing exactly what I wanted, so thanks again for
your
help.

Chris

"Bob Phillips" wrote:

And that is working fine is it?

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Mnay thanks Bob. Here is the final version I am now using:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Details").Range("J3:V74")
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("F2:F100").Find(cell.V alue)
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

Sub clearcells()
Dim cell As Range
For Each cell In Worksheets("Details").Range("J3:V74")
cell.Interior.ColorIndex = xlAutomatic
Next cell
End Sub

Run via 2 command buttons - one to set the colours, the other to clear
them.

Chris

"Bob Phillips" wrote:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets("Sheet2").Cells.Find(cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
Next cell
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains
unique 4
character text codes, e.g. ABXY, each cell is coloured manually by
the
user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character
codes.
- I would like to colour the cells in sheet 1 to the same colour
as
the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with,
so
I'd be
very grateful for your help and suggestions.

Thanks, Chris

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?

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?

Thanks, Chris

"Bob Phillips" wrote:

Excellent.

Regards

Bob

"ChrisO" wrote in message
...
Bob,

Yes, this seems to be doing exactly what I wanted, so thanks again for
your
help.

Chris

"Bob Phillips" wrote:

And that is working fine is it?

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Mnay thanks Bob. Here is the final version I am now using:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Details").Range("J3:V74")
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("F2:F100").Find(cell.V alue)
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

Sub clearcells()
Dim cell As Range
For Each cell In Worksheets("Details").Range("J3:V74")
cell.Interior.ColorIndex = xlAutomatic
Next cell
End Sub

Run via 2 command buttons - one to set the colours, the other to clear
them.

Chris

"Bob Phillips" wrote:

Sub colourcells()
Dim cell As Range
Dim rng As Range
For Each cell In Worksheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Worksheets("Sheet2").Cells.Find(cell.Value)
On Error GoTo 0
If Not rng Is Nothing Then
cell.Interior.ColorIndex = rng.Interior.ColorIndex
End If
Next cell
End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"ChrisO" wrote in message
...
Hello,
I want to do the following:

- in sheet 2 a column of cells (could be up to 100) contains
unique 4
character text codes, e.g. ABXY, each cell is coloured manually by
the
user
to any background colour they like.
- in sheet 1 a range of cells each contain one of the 4 character
codes.
- I would like to colour the cells in sheet 1 to the same colour
as
the
corresponding cell for the code in sheet 2.

I know this is going to require VBA which I'm not familiar with,
so
I'd be
very grateful for your help and suggestions.

Thanks, Chris

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

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