VBA help to colour TOC cell with corresponding tab colour

[Marcus131975]

Hi

The below extract from VBA code creates a Table of Contents (based on worksheet names) and additionally adds a comments column and a further column with the numeric value of the corresponding tab colour.

Is there a way to amend it so that the cell in column F is actually the same colour as the tab, rather than just populated with the numeric value of that colour?

'Loop through all sheets
For Each ws In wb.Worksheets
If ws.Name <> wsTOC.Name Then
If ws.Visible = True Then
With wsTOC
.Range("B" & r) = ws.Name
.Range("E" & r) = ws.Range("CA1")
.Range("F" & r) = ws.Tab.Color
End With
End If

If ws.Visible = True Then
wsTOC.Hyperlinks.Add Anchor:=wsTOC.Cells(r, 2), Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
End If
End If
r = r + 1
Next ws

 

[Yongle]

Replace that line with ...

  .Range("F" & r).Interior.Color = ws.Tab.Color

'Loop through all sheets
For Each ws In wb.Worksheets
    If ws.Name <> wsTOC.Name Then
        If ws.Visible = True Then
            With wsTOC
                .Range("B" & r) = ws.Name
                .Range("E" & r) = ws.Range("CA1")
               .Range("F" & r).Interior.Color = ws.Tab.Color
            End With
        End If
        If ws.Visible = True Then
            wsTOC.Hyperlinks.Add Anchor:=wsTOC.Cells(r, 2), Address:="", _
            SubAddress:="'" & ws.Name & "'!A1"
        End If
    End If
    r = r + 1
Next ws

In future remember to use code tags around your code
If you want to format the font to highlight something ... click on RICH icon ... otherwise click on VBA icon

[ CODE=rich]code goes here[/CODE]


[ CODE=vba]code goes here[/CODE]

 

[Marcus131975]

Replace that line with ...

  .Range("F" & r).Interior.Color = ws.Tab.Color

'Loop through all sheets
For Each ws In wb.Worksheets
    If ws.Name <> wsTOC.Name Then
        If ws.Visible = True Then
            With wsTOC
                .Range("B" & r) = ws.Name
                .Range("E" & r) = ws.Range("CA1")
               .Range("F" & r).Interior.Color = ws.Tab.Color
            End With
        End If
        If ws.Visible = True Then
            wsTOC.Hyperlinks.Add Anchor:=wsTOC.Cells(r, 2), Address:="", _
            SubAddress:="'" & ws.Name & "'!A1"
        End If
    End If
    r = r + 1
Next ws

In future remember to use code tags around your code
If you want to format the code click on RICH icon (otherwise click on VBA)

[ CODE=rich]code goes here[/CODE]


[ CODE=vba]code goes here[/CODE]

Thanks you very much and noted about the code tags. Apologies for that.

 

[Yongle]

You are welcome