List Sheet names and tab colors

[sedgely]

I have the following code to list all worksheet names and their corresponding tab colors, it seems to work fine EXCEPT where the tab has no color in which case it shows as black. cna anyone suggest what i am doing wrong?
Many Thanks

Sub ListWorkSheetNamesAndTabColors()
Set wks = Sheets("SheetList")
wks.Columns("A:B").EntireColumn.Delete
For i = 1 To Sheets.Count
wks.Range("$A$1").Value = "SheetName"
wks.Range("$B$1").Value = "TabColour"
wks.Range("A" & i + 1) = Sheets(i).Name
wks.Range("B" & i + 1).Interior.Color = Sheets(i).Tab.Color
Next i
End Sub

Cheers, Craig
Si fractum non sit, noli id reficere

 

[PHV]

What about this ?

Sub ListWorkSheetNamesAndTabColors()
Set wks = Sheets("SheetList")
wks.Columns("A:B").EntireColumn.Delete
wks.Range("$A$1").Value = "SheetName"
wks.Range("$B$1").Value = "TabColour"
For i = 1 To Sheets.Count
    wks.Range("A" & i + 1) = Sheets(i).Name
    wks.Range("B" & i + 1).Interior.ColorIndex = Sheets(i).Tab.ColorIndex
Next i
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[sedgely]

PHV
Thanks for the reply, i've tried that and it matches the tabs with no colour but all the coloured tabs are showing as totally different colours e.g. a Red Tab shows as green in the list?

Cheers, Craig
Si fractum non sit, noli id reficere

 

[SkipVought]

hi,

Sub ListWorkSheetNamesAndTabColors()
    Dim wks As Worksheet, ws As Worksheet, iCol As Integer
    
    Set wks = Sheets("SheetList")
    wks.Columns("A:B").EntireColumn.Delete
    
    iCol = 1
    For Each ws In Worksheets
        iCol = iCol + 1
        wks.Cells(1, "A").Value = "SheetName"
        wks.Cells(1, "B").Value = "TabColour"
        wks.Cells(iCol, "A") = ws.Name
        [highlight #FCE94F]If ws.Tab.Color <> vbBlack Then _[/highlight]
            wks.Cells(iCol, "B").Interior.Color = ws.Tab.Color
    Next
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[PHV]

So, try this:

Sub ListWorkSheetNamesAndTabColors()
Set wks = Sheets("SheetList")
wks.Columns("A:B").EntireColumn.Delete
wks.Range("$A$1").Value = "SheetName"
wks.Range("$B$1").Value = "TabColour"
For i = 1 To Sheets.Count
    wks.Range("A" & i + 1) = Sheets(i).Name
    If Sheets(i).Tab.Color = 0 Then
        wks.Range("B" & i + 1).Interior.ColorIndex = Sheets(i).Tab.ColorIndex
    Else
        wks.Range("B" & i + 1).Interior.Color = Sheets(i).Tab.Color
    End If
Next i
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[strongm]

It isn't clearly documented, but if No Color is set on a tab, then .Color returns False (and .ColorIndex returns xlColorIndexNone) rather than a color value. Unfortunately VBA carries out an implicit type conversion to a long when using this value to subsequently set a color - and False = 0, which is black ...

So the trick is to check .ColorIndex, and if it is xlColorIndexNone do not set the color

 

[strongm]

So, following your code as closely as possible:

[blue]Sub ListWorkSheetNamesAndTabColors()
    Set wks = Sheets("SheetList")
    wks.Columns("A:B").EntireColumn.Delete
    For i = 1 To Sheets.Count
        wks.Range("$A$1").Value = "SheetName"
        wks.Range("$B$1").Value = "TabColour"
        wks.Range("A" & i + 1) = Sheets(i).Name
        wks.Range("B" & i + 1).Interior.Color = Sheets(i).Tab.Color
        If Sheets(i).Tab.ColorIndex = xlColorIndexNone Then
            wks.Range("B" & i + 1).Interior.ColorIndex = xlColorIndexNone
        End If
    Next i
End Sub[/blue]

 

[sedgely]

thanks strongm, works a treat. and thanks for the explanation, makes perfect sense now

Cheers, Craig
Si fractum non sit, noli id reficere

 

[Andrzejek]

And I would place rhis:

wks.Range("$A$1").Value = "SheetName"
wks.Range("$B$1").Value = "TabColour"
For i ...

before the For loop, as PHV stated.
No reason to write it 15 times when you have 16 tabs.

Have fun.

---- Andy