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

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Sheet1 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. The macro runs automatically whenever you activate Sheet1.

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Range("A2:A21")
        If rng <> "" Then
            rng.Interior.Color = Sheets(rng.Value).Tab.Color
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[kelvin_9]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Sheet1 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. The macro runs automatically whenever you activate Sheet1.

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Range("A2:A21")
        If rng <> "" Then
            rng.Interior.Color = Sheets(rng.Value).Tab.Color
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Hi mumps
thank you very much for your reply

i use a test workbook to run my code to color tab first, and then do what you said
when i get back to sheet run, run time error 9 and yellow highlighted:

rng.Interior.Color = Sheets(rng.Value).Tab.Color

beside, can i run my code and run this with a button?
thank you very much

 

[mumps]

Delete the previous macro. Place this macro in a regular module and assign it to your button:

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("A2:A21")
        If rng <> "" Then
            rng.Interior.Color = Sheets(rng.Value).Tab.Color
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[kelvin_9]

Delete the previous macro. Place this macro in a regular module and assign it to your button:

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("A2:A21")
        If rng <> "" Then
            rng.Interior.Color = Sheets(rng.Value).Tab.Color
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Hi mumps
thank you very much for your reply

same result as yellow highlighted?
what did i wrong

rng.Interior.Color = Sheets(rng.Value).Tab.Color

thank you very much

 

[mumps]

I tested the macro on some dummy sheets and it worked properly. Could you upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here (de-sensitized if necessary).

 

[kelvin_9]

I tested the macro on some dummy sheets and it worked properly. Could you upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here (de-sensitized if necessary).

Hi mumps,
thank you very much for your reply

how about mycloud?
http://kel.ddns.net/f/80191ebf62/?raw=1
remarks:
i amend your code at module 4 with: range as A2:A1000, sheet2 named "summary" instead sheet1

if everything is fine,
row 749 should be colorindex 8
row 750 should be colorindex 7

thank you very much

 

[mumps]

My anti virus software won't allow me to download the file using that link. Try DropBox.com or Box.com.

 

[kelvin_9]

My anti virus software won't allow me to download the file using that link. Try DropBox.com or Box.com.

Hi mumps
thank you very much for your reply

how about this link?

test.xlsm

Shared with Dropbox

www.dropbox.com

thank you very much

 

[mumps]

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.