Mirror the format of another cell automatically

WildAngus

New Member
Joined
Jan 10, 2007
Messages
28
Hi,

Does anyone know if it is possible to mirror the format of another cell without using the format painter?
e.g. Cell A1 is BLUE and BOLD, Cell A2 is Red and non-Bold, Cell A3 is green and italics, Cell A4 is Yellow and undelined.
I want to have cell B1 formatted the same as A1 if it contains a 1, A2 for 2, A3 for 3 and A4 for 4.
i.e. B1 pulls in the format of a cell based on a value.

I know this is on the lines of conditional formatting, but wondedred if there was a command to make Cell B1 = the format of Cell A2

Does this make sense?
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
The following will work, it is best to run it whenever you want to change the formats as if you put it in worksheet selection change it will run everytime a cell changes.

You could either put it in the workbook before save or open or close event though if you wanted too.

Code:
Sub Color1()
Range("B1").Select
ActiveCell.Offset(0, -1).Select
Cells(65535, ActiveCell.Column).Select
   Range(Selection, Selection.End(xlUp)).Select
   ActiveCell.Select
   ActiveCell.Offset(0, 1).Select
Set BottomCell = ActiveCell
    Set TopCell = Cells(1, ActiveCell.Column)
      Range(TopCell, BottomCell).Select
 
 
     Dim Cell As Range
For Each Cell In Selection
 
  ActiveCell.Offset(0, -1).Select
  Selection.Copy
  ActiveCell.Offset(0, 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 ActiveCell.Offset(1, 0).Select
Next Cell
Range("B1").Select
    Application.CutCopyMode = False
 
 End Sub

Or you could put a call event in the before doubleclick event of the worksheet as follows.

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call Color1
End Sub
 
Upvote 0
Sorry I should have read your post better.

Try the following however you will need to record your own code to get the specific cell colors etc... as I am using excel 2010 and the colors differ.

Put this in your worksheet code

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Color2
End Sub

put this in a module

Code:
Sub Color2()
If Range("A1").Value = 1 Then
Range("B1").Font.Bold = True
Range("B1").Interior.Color = 3
End If
End Sub

just copy the color2 script for extra conditions ie.

Code:
Sub Color2()
If Range("A1").Value = 1 Then
Range("B1").Font.Bold = True
Range("B1").Interior.Color = 3
End If
 
If Range("A1").Value = 2 Then
Range("B1").Font.Bold = false
Range("B1").Interior.Color = 2
End If
 
If Range("A1").Value = 3 Then
Range("B1").Font.Bold = True
Range("B1").Interior.Color = 4
End If
 
end sub
 
Upvote 0
It might be easier to use copy - paste special formats then to use a hard coding of each individual format. (code runs on selection change -- I'm not real good with worksheet events, so maybe somebody else will give you hand with that part)

change "NameOfWorksheetWithFormatting" to the name of the sheet with the formatting.

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim c
    For Each c In Target
        Select Case c.Value
        Case 1
            Worksheets("NameOfWorksheetWithFormatting").Range("A1").Copy
            c.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
        Case 2
            Worksheets("NameOfWorksheetWithFormatting").Range("A2").Copy
            c.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
        Case 3
            Worksheets("NameOfWorksheetWithFormatting").Range("A3").Copy
            c.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
        Case 4
            Worksheets("NameOfWorksheetWithFormatting").Range("A4").Copy
            c.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
        Case Else
            'do nothing
        End Select
    Next c
End Sub

I think you'd be better off using conditional formatting than any sort of macro, though.
 
Upvote 0

Forum statistics

Threads
1,224,520
Messages
6,179,266
Members
452,902
Latest member
Knuddeluff

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top