CODEWITHSUNDEEP
excelvbaformattingconditional-formatting
gagrot
gagrot

Reputation: 1

Excel: copy cell' conditional formatting colour to all cells with same value

Reference Image

The Aim: The image shows the “key” on the left, where cells will be coloured manually using mouse input. A (red background) B (green background) C (blue background) On the right, you see the "data" where content-matching cells should be formatted to match their key (as I've already done for representation purpose in the image)

Initial Situation: No cells are coloured or formatted in any way. The Excel spreadsheet has column A with certain values, And rest of the columns (C onwards) have the same/different values in a random manner (some cells even empty). Not all values in "key" area will be found in "Data" area or vice versa. No new data is being added in any area. User will only colour certain Values in "Key" area as per their wish.

Thus all “C” cells in the Data area should be coloured blue when "C" in Key area is coloured blue. Furthermore, if I change the formatting of “C” in the Key to have a purple background, all the “C” cells should switch from blue to purple. Also, if I add more to the Key (say, “D” with a yellow background) then any “D” cells should become yellow; if I remove a Key entry, then matching values in the Data area should revert to default styling.

I'm open to different trigger techniques,like manually running a macros via shortcut etc. I suspect that if any of this is possible it will require VBA, but I’ve never used it so I’ve no idea where to start if that’s the case. The closest answer to my question was found here but doesn't entirely work for me:

Upvotes: 0

Views: 887

Answers (1)

Christofer Weber
Christofer Weber

Reputation: 1474

First I though of using the Worksheet.Change event, by putting something like this into the worksheet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim area As Range, c As Range
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
    Set area = Range("B1:F20")
    For Each c In area
        If c.Value = Target.Value Then c.Interior.Color = Target.Interior.Color
    Next c
End If
End Sub

This is just a non-dynamic rough draft, but it "kind of" works.
Problem is that a change of color doesn't trigger the change event, funnily enough, changing the letter to the same letter – so no change at all – does trigger the event, as illustrated below:

enter image description here

We could use the Worksheet_SelectionChange event instead, but then it wouldn't update until next time we selected the cell we want to update.

We could instead force it to update on next selection. Which isn't optimal either:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim reference As Range, refCell As Range, area As Range, areaCell As Range
Set reference = Range("A1:A3")      'Reference range
Set area = Range("B1:F20")          'Search range
    For Each refCell In reference   'Loop through the references
        For Each areaCell In area   'Loop through search range for each reference
            If areaCell.Value = refCell.Value Then areaCell.Interior.Color = refCell.Interior.Color
        Next areaCell
    Next refCell
End Sub

enter image description here

Obviously, using a button or similar to run the same code would also work, but I'm not entirely sure if we can make it run instantly.

To run it manually, put it as a normal sub in a module. (It still works in the sheet though).

Sub fillColor()
Dim reference As Range, area As Range, areaCell As Range
Application.ScreenUpdating = False
Set reference = Range("A1")
Set area = Range("B1:E25")
        For Each areaCell In area
            If areaCell.Value = reference.Value Then
                areaCell.Interior.Color = reference.Interior.Color
                areaCell.Interior.Pattern = reference.Interior.Pattern
            End If
        Next areaCell
Application.ScreenUpdating = True
End Sub

Still, you might want to add an option on what to to update, so it doesn't update it all.

Upvotes: 1

Related Questions