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 |
"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