Summary sheet colour

[mattless1]

Hi All,

I have a summary sheet with all my suppliers on it.
is there a way I can colour the supplier names in the summary sheet with colour of their tabs.

thanks in advance.

 

[Yongle]

VBA below assumes
- supplier name is in column A of sheet named "Summary"
- supplier name on tab is the SAME as supplier name in sheet "Summary"

Sub ColorSupplier()
    Dim supplier As Range, ws As Worksheet
    For Each supplier In Sheets("Summary").Range("A2", Sheets("Summary").Range("A" & Rows.Count).End(xlUp))
        For Each ws In ThisWorkbook.Sheets
            If UCase(ws.Name) = UCase(supplier) Then
                supplier.Interior.Color = ws.Tab.Color
                Exit For
            End If
        Next ws
    Next supplier
End Sub

 

[mattless1]

Hi Yongle
thanks, but the code didn't work for me. A4 is the start location of the supplier names, I tried changing the cell ref in script to that cell, but nothing worked.

thanks,
Larry

 

[Fluff]

Are the supplier names in column A exactly the same as the sheet names?

 

[mattless1]

Yes,

cell A4 has 6th Sense and the tab has 6th Sense

 

[Fluff]

As a test what happens if you run this

Sub mattless1()
    With Sheets("summary").Range("A4")
        .Interior.Color = Sheets(.Value).Tab.Color
    End With
End Sub

 

[mattless1]

Hi Yongle,

that ran ok it change the cell to blue

 

[mattless1]

Could arrange the code so the if the colour changes if it changes to?

 

[Fluff]

In that case if the code is in the same workbook as the summary sheet, Yongle's code should work.
If you have put the code in a different workbook, try

Sub ColorSupplier()
    Dim supplier As Range, ws As Worksheet
    For Each supplier In Sheets("Summary").Range("A4", Sheets("Summary").Range("A" & Rows.Count).End(xlUp))
        For Each ws In ActiveWorkbook.Sheets
            If UCase(ws.Name) = UCase(supplier) Then
                supplier.Interior.Color = ws.Tab.Color
                Exit For
            End If
        Next ws
    Next supplier
End Sub

 

[mattless1]

Hi Fluff,

it did fill the cells, but I got an Expected End Sub Error