Setting the color of a cell from a cell

[quarterhours]

I have two worksheets with similar data. In fact they are almos
identical. I would like to use a third worksheet to show the cell
which are equal as yellow and those which are different as red.

I have made an attempt at writing it, and have searched the forums, bu
can't find anyone trying to do this.


Here the cell formula in 'sheet3'!A1(copied to the whole sheet):

=if('sheet1'!a1='sheet2'!a1,setColor('sheet3'!a1,1),setColor('sheet3'!a1,3))

Here is my code for setColor():

Function setColor(R As Range, C As Integer)
For Each X In R
X.Interior.ColorIndex = C
Next
End Functio

 

[Frank Kabel]

Hi
a function can't change the Excel environment (e.g. fonts, colors,
etc.). Therefore the code below won't work. The only way to change
colors would be
- using a macro (manually started)
- use an event procedure whcih would check the entries in your cells
after changing a cell

 

[Bob Phillips]

There is nothing intrinsically wrong with the logic of your code, but Excel
does not allow you to modify cell attributes in a UDF, only return a result.
So you can't do it that way.

An alternative might be conditional formatting, but the problem here is that
you have to use named ranges across separate worksheets, and for all cells,
that looks tricky.

My suggestion is event code, trap the input on sheets 1 or 2, and colour
sheet 3 accordingly.

Try this code in the ThisWorkbook code module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = False
On Error GoTo wb_exit
If Sh.Name = "Sheet1" Then
If Target.Value <> Worksheets("Sheet2").Range(Target.Address).Value
Then
Worksheets("Sheet3").Range(Target.Address).Interior.ColorIndex =
3
End If
ElseIf Sh.Name = "Sheet2" Then
If Target.Value <> Worksheets("Sheet1").Range(Target.Address).Value
Then
Worksheets("Sheet3").Range(Target.Address).Interior.ColorIndex =
3
End If
End If

wb_exit:
Application.EnableEvents = True
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)