Change cell colour based on cell colour of another cell

[kayakginge]

Hi All,

Is it possible to do the following:

Change the background colour of a cell based on the background colour of a cell on another sheet.

I would like to have 4 pages all linked together whereby if i change the background colour of a cell on the master sheet (B12 for example) then the background colour of B12 on the other three sheets will change to the same colour.

I would like to do this for an array of cells, B4:F64.

Any help would be greatly appreciated.

Many thanks in advance

 

[Scott T]

If the color of the cell in the master sheet is changed manually then you would need to use VBA to do this. If the cell color is based on conditions then you can use Conditional Formatting.

 

[kayakginge]

Hi Scott,

Sorry i did not make that clear.

The master sheet cells would be changed manually.

The other three sheets are hidden and are used for analysis but are not needed on a day to day basis so i would like the colour changes to be automatic to save time unhiding sheets.

Many thanks

 

[Scott T]

Unfortunately changing a cells fill color does not trigger the worksheet change event. This could be set to run on a different event like selection change but then the code would be run even when not need.

What are the names of your sheets?

 

[Eric W]

I'd suggest using a SheetDeactivate event. You'd make the manual changes on one of your sheets, and when you change sheets, it would copy the colors to the other sheets. To try that, open a copy of your workbook. Press Alt-F11 to open the VBA editor. On the left is a navigation panel. Find your workbook, click on the plus sign for it (if necessary), then double click on the ThisWorkbook item. In the sheet on the right, paste this code:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim ColorSheets As Variant, ws As Variant, c As Range

    ColorSheets = Array("Sheet1", "Sheet2", "Sheet4", "Sheet13")
    
    If UBound(Filter(ColorSheets, Sh.Name)) = -1 Then Exit Sub
    
    For Each ws In ColorSheets
        If CStr(ws) <> Sh.Name Then
            For Each c In Sheets(ws).Range("B4:F64")
                c.Interior.ColorIndex = Sh.Range(c.Address).Interior.ColorIndex
            Next c
        End If
    Next ws

End Sub

Change the values in red to match your workbook. Close the editor and try it out. Note that if you change some colors, then exit before changing sheets, the colors will not be copied.

Hope this helps.

 

[DanteAmor]

If the sheet is hidden then the colors will not be seen until you make the sheet visible. Then at that time, the colors will appear in automatic, use the following code for it.
Put the code in the events of this workbook. Change "sheet2""sheet3""sheet4""master" by the names of your sheets.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Select Case LCase(Sh.Name)
        Case LCase("sheet2"), LCase("sheet3"), LCase("sheet4")
            Application.ScreenUpdating = False
            For Each wcell In Sheets("master").Range("B4:F64")
                If wcell.Interior.Color <> 16777215 Then
                    Sh.Range(wcell.Address).Interior.Color = wcell.Interior.Color
                End If
            Next
    End Select
End Sub

let me know if you have any questions

 

[kayakginge]

If the sheet is hidden then the colors will not be seen until you make the sheet visible. Then at that time, the colors will appear in automatic, use the following code for it.
Put the code in the events of this workbook. Change "sheet2""sheet3""sheet4""master" by the names of your sheets.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Select Case LCase(Sh.Name)
        Case LCase("sheet2"), LCase("sheet3"), LCase("sheet4")
            Application.ScreenUpdating = False
            For Each wcell In Sheets("master").Range("B4:F64")
                If wcell.Interior.Color <> 16777215 Then
                    Sh.Range(wcell.Address).Interior.Color = wcell.Interior.Color
                End If
            Next
    End Select
End Sub

let me know if you have any questions

Hi Dante,

This works well, however if the colour is changed to No fill then the colour does not update to blank again. Is there a way of forcing it in this scenario?

Many thanks

 

[DanteAmor]

It has that detail, since white is different from No fill, try with this

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Select Case LCase(Sh.Name)
        Case LCase("sheet2"), LCase("sheet3"), LCase("sheet4")
            Application.ScreenUpdating = False
            For Each wcell In Sheets("master").Range("B4:F64")
                If wcell.Interior.Color <> 16777215 Then
                    Sh.Range(wcell.Address).Interior.Color = wcell.Interior.Color
                Else
                    If Sh.Range(wcell.Address).Interior.Color <> wcell.Interior.Color Then
                        Sh.Range(wcell.Address).Interior.Pattern = xlNone
                    End If
                End If
            Next
    End Select
End Sub

 

[kayakginge]

Hi Dante,

Thank you so much, that worked perfectly.

Kind Regards

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.