ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   linking cells colors (https://www.excelbanter.com/excel-worksheet-functions/7810-linking-cells-colors.html)

Jaan

linking cells colors
 
Hi
Is it possible to link one Excel worksheet to another sheet with all cells
colors
Example--sheet1 cellA1 font color is red.After linking I like to see same
font color in the sheet2 cellA1
How it is possible
--
jaan

Harlan Grove

"Jaan" wrote...
Is it possible to link one Excel worksheet to another sheet with all cells
colors
Example--sheet1 cellA1 font color is red.After linking I like to see same
font color in the sheet2 cellA1
How it is possible


It could be done using VBA to program a Change event handler. It would work
by finding the first range reference in a formula, copying the format in the
first cell of that range and pasting it as a format onto the cell containing
the reference. It wouldn't (can't) change when the format of the referenced
range changes, but you could select the cells in question and Edit Replace
= with = to rerun the Change event handler on all cells containing formulas.

The problem is that it's not all that easy to locate the first range
reference in a formula. Even so, here's a lightly tested possibility. It
needs to be copied from here and pasted into the class module for the
worksheet in which you want this functionality.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, s As Range
Dim f As String, g As String
Dim i As Long, j As Long

On Error GoTo CleanUp
Application.EnableEvents = False

For Each c In Target

If c.HasFormula Then
f = c.Formula
g = c.FormulaR1C1

If f < g Then
For i = 2 To Len(f)
If Mid(f, i, 1) < Mid(g, i, 1) Then Exit For
Next i

j = 0
Do
j = j + 1
Loop While Mid(f, i + j, 1) Like "[$A-Z0-9]"

If Mid(f, i - 1, 1) = "!" Then
i = i - 2
j = j + 2

If Mid(f, i, 1) = "'" Then
'the following doesn't work for external references to
'workbooks with single quotes in their filenames - that's
'left as an exercise for the masochistic
Do Until Mid(f, i - 1, 1) = "'"
i = i - 1
j = j + 1
Loop

Else
Do While Mid(f, i - 1, 1) Like "[_A-Za-z0-9]"
i = i - 1
j = j + 1
Loop

End If

End If

Set s = Evaluate(Mid(f, i, j))
s.Copy
c.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False

Exit For

End If

End If

Next c

CleanUp:
Application.EnableEvents = True

End Sub




All times are GMT +1. The time now is 12:15 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com