If cell colour is, then change cell colour in another tab (with matching value).

[Roksman]

Hi All,

I confess that I initially tried this on Google Sheets and posted in another thread, but I am going to now recreate this work in Microsoft Excel as it just seems the better option given it appears VBA is the better option - so please ignore the screenshots being GS.

I.e. If I change A9 cell colour to red, can I then have the same value cell in tab "Midfielders" (A15) also change to red automatically?

Effectively, tab "2022 list" is my primary checklist and as I highlight the cells in this list, can the corresponding matching name across tabs 'DEFENDERS', 'MIDFIELDERS', 'RUCKS' and "FORWARDS' mimic the cell colour as I highlight them?

Any assistance will be much appreciated. Thanks.

 

[rollis13]

There is no event to detect (that triggers with) a change of color in a cell so try this workaround. Note that the cells in the other sheets will color only when you move, in the same sheet, from the cell in column A after changing it's color, elsewise it won't trigger (like changing sheet).
As per your example, in a test book in ThisWorkBook's module paste this macro:

Option Explicit
Private Sub Workbook_Open()
    Range("B1").Select                            '<- as range choose an unused cell but not in column A
End Sub

and in the sheet '2022 List''s module paste this:

Option Explicit
Public LastRange As Range
Public LastCellColor As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myArr  As Variant
    Dim sht    As Variant
    Dim fndRow As Range
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If LastCellColor = 0 Then GoTo setvar
    If LastRange.Interior.ColorIndex <> LastCellColor Then
        If Not Intersect(LastRange, Range("A:A")) Is Nothing Then
            myArr = Array("DEFENDERS", "MIDFIELDERS", "RUCKS", "FORWARDS") 'list of sheets
            For Each sht In myArr
                With Sheets(sht)
                    Set fndRow = .Range("A:A").Find(What:=LastRange.Value, LookIn:=xlValues, LookAt:=xlWhole) 'search for name
                    If Not fndRow Is Nothing Then
                        .Range("A" & fndRow.Row).Interior.ColorIndex = LastRange.Interior.ColorIndex 'color cell found
                    End If
                End With
            Next sht
        End If
    End If
setvar:
    Set LastRange = Target
    LastCellColor = Target.Interior.ColorIndex
End Sub

If the test goes well, try integrating everything into your project.

 

[Roksman]

Thank you very much @rollis13, this works.

Much appreciated.

 

[rollis13]

Glad having been of some help.
The marco has no apparent issue with your test example but since it has been freshly coded has never been thoroughly tested. I would say that you will be the second beta-tester (I'm the first) or first on the field . A professional would probably make it better .