excel vba change cell color based on tabs color

[kelvin_9]

Hello All,

assuming i have 20 data in range A2:A21 at sheet 1 and they are same as the tabs name
i need a vba to return same color index (3, 5 and 6) in column A if tabs color was changed

example: when tabs name(220408120732319399) was changed to colorindex 5, i want cell A9(220408120732319399) change to colorindex 5 as well

thank you very much

 

[kelvin_9]

Try:

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim fnd As Range
    For Each ws In Sheets
        If IsNumeric(ws.Name) Then
            Set fnd = Sheets("SUMMARY").Range("A:A").Find(ws.Name)
            If Not fnd Is Nothing Then
                fnd.Interior.Color = Sheets(ws.Name).Tab.Color
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

The macro assumes that the sheet names will consist only of numbers.

Hi mumps
thank you very much for your reply

THIS IS IMPECCABLE
i found sheet "summary" return 4 color which is exactly correct
blue and purple as tabs color
black as default which is no color
no filled as no founding

thank you very much

 

[mumps]

You are very welcome.

 

[kelvin_9]

Hi mumps

is this code can be amended if tab(s) didnt changed it's color, keep sheet "summary"

You are very welcome.

Hi mumps
can i use black color as no founding and keep it as default(no color) instead?

thank you very much again

 

[mumps]

I'm sorry but I don't quite understand what you mean. Please clarify in detail using a few examples.

 

[kelvin_9]

I'm sorry but I don't quite understand what you mean. Please clarify in detail using a few examples.

Hi mumps
thank you very much for your reply

sorry for my poor language

example as below picture, row54 - row63
you will see row56, row57, row 61 or row 63... colored as tab color
but you will see row55, row58 or row62 is black, i want this no color
on the other contrary, row54, row59 & row60, this is not existed in workbook, so i want this black

2.jpg

 

[mumps]

Hopefully, I have understood correctly.

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim v As Variant, desWS As Worksheet, i As Long
    Set desWS = Sheets("SUMMARY")
    With desWS
        v = .Range("A2", .Range("A" & .Rows.count).End(xlUp))
        For i = LBound(v) To UBound(v)
            If Evaluate("isref('" & CStr(v(i, 1)) & "'!A1)") Then
                If Sheets(CStr(v(i, 1))).Tab.Color <> 0 Then
                    .Range("A" & i + 1).Interior.Color = Sheets(CStr(v(i, 1))).Tab.Color
                End If
            Else
                .Range("A" & i + 1).Interior.Color = vbBlack
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[kelvin_9]

Hopefully, I have understood correctly.

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim v As Variant, desWS As Worksheet, i As Long
    Set desWS = Sheets("SUMMARY")
    With desWS
        v = .Range("A2", .Range("A" & .Rows.count).End(xlUp))
        For i = LBound(v) To UBound(v)
            If Evaluate("isref('" & CStr(v(i, 1)) & "'!A1)") Then
                If Sheets(CStr(v(i, 1))).Tab.Color <> 0 Then
                    .Range("A" & i + 1).Interior.Color = Sheets(CStr(v(i, 1))).Tab.Color
                End If
            Else
                .Range("A" & i + 1).Interior.Color = vbBlack
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Hi mumps
thank you for your reply

it works wonderful

thank you very much

 

[mumps]

My pleasure.

 

[kelvin_9]

My pleasure.

Hopefully, I have understood correctly.

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim v As Variant, desWS As Worksheet, i As Long
    Set desWS = Sheets("SUMMARY")
    With desWS
        v = .Range("A2", .Range("A" & .Rows.count).End(xlUp))
        For i = LBound(v) To UBound(v)
            If Evaluate("isref('" & CStr(v(i, 1)) & "'!A1)") Then
                If Sheets(CStr(v(i, 1))).Tab.Color <> 0 Then
                    .Range("A" & i + 1).Interior.Color = Sheets(CStr(v(i, 1))).Tab.Color
                End If
            Else
                .Range("A" & i + 1).Interior.Color = vbBlack
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Hi mumps,

with more efficiency and convenience now, can i add a sorting function in this code, first when cell color index = 0, last when cell color index = black
ps: doesn't matter on other colors

thank you very much

 

[mumps]

first when cell color index = 0, last when cell color index = black

Please explain in detail.