count by colour of the sheet tab

February 11, 2010 at 08:32:28
Specs: Windows XP
Hi guys, me again.
Was wondering if it was possible to count by the colour of a sheet tab? I categorise files depending on their status by colour - red for incomplete, orange for in progress and green for done. I want to be able to count how many are red so I know how many need to be looked at, and so on and so forth.

See More: count by colour of the sheet tab

Report •

February 11, 2010 at 12:08:06

You can write a macro to count all the Tabs that have a certain color.

The results are then entered into three cells.

One issue will be to ensure that the Tab colors are exactly one of your specific three colors.

Option Explicit

Sub TabClrCnt()
Dim ws As Worksheet
Dim dblClr As Double

'on error goto ErrHnd

'reset counters in cells B2, B3 & B4
With ActiveSheet
    .Range("B2").Value = 0
    .Range("B3").Value = 0
    .Range("B4").Value = 0

'count colours
For Each ws In ActiveWorkbook.Worksheets()
    dblClr = ws.Tab.Color
    Select Case dblClr
        Case Is = 255
        .Range("B2").Value = .Range("B2").Value + 1
         Case Is = 65535
        .Range("B3").Value = .Range("B3").Value + 1
        Case Is = 65280
        .Range("B4").Value = .Range("B4").Value + 1
    End Select
Next ws
End With
Exit Sub

'error handler
End Sub

Change color numbers to match.
(Select tab colors, then put a breakpoint in the code after dblClr = ws.Tab.Color and each time the code stops, record the color number.
Then change the codes in the Select Case statements).


Report •

February 11, 2010 at 12:30:25
re: Select tab colors, then put a breakpoint in the code after dblClr = ws.Tab.Color and each time the code stops, record the color number.

I don't have 2007, but this worked to "automate" determining - and recording - the color numbers for each tab in a 2003 workbook.

Cells in Column A will hold the ColorIndex value and cells in Column B will show the associated colors.

Sub WhatColorBeMyTabs()
 For Each ws In ActiveWorkbook.Worksheets()
    dblClr = ws.Tab.ColorIndex
     nxtRow = nxtRow + 1
      Range("A" & nxtRow) = dblClr
      Range("B" & nxtRow).Interior.ColorIndex = dblClr
End Sub

Report •

February 12, 2010 at 02:16:48
Thanks so much. The code seems to count okay the tabs that are red, but even when i have a break line on a tab that may be green or organge, the value of DblClr is always 65535!

Report •

Related Solutions

February 12, 2010 at 04:25:44
Did you try the code I suggested in Response # 2 to help determine the values to use for the tab color variable?

Note that is uses the Tab.ColorIndex instead of Tab.Color.

Report •

February 12, 2010 at 04:29:40

Add a new worksheet and use DerbyDad03's macro.

It will list each Tab's color number with its color.


Report •

February 12, 2010 at 04:37:55
Hi guys.
yup tried the code derbydad, its gives me 10, 51 and 11 as the codes but the corresponding colours do not match (the tabs are a simple red, organse and lime green)

Report •

February 12, 2010 at 06:37:03
I'm not sure what's going on in your workbook, but I ran this in Excel 2003 using the ColorIndex values you gave us.

It sets the tab colors based on those numbers, then fills A1:A56 with all of the available fill colors and then compares the Tab ColorIndex values to each cell looking for a match. When it finds that match, it fills the corresponding cell in Column B with the matching color.

The only purpose of this code is to show that the same ColorIndex values should work for both Tabs and Cells, at least in 2003.

Perhaps you could set the tab colors based on the ColorIndex values determined by my code and then count them. The Row number is the ColorIndex value to use.

Sub CheckTabColors()
 'Set Tab Colors
 '10 = Green
 Sheets(1).Tab.ColorIndex = 10
 '51 = Dark Green
 Sheets(2).Tab.ColorIndex = 51
 '11 = dark Blue
 Sheets(3).Tab.ColorIndex = 11
   MsgBox "Tab Colors Are Set"

'Fill A1:A56 by ColorIndex Number
  For rw = 1 To 56
   Cells(rw, 1).Interior.ColorIndex = rw
   MsgBox "Column A Colors are Set"

'Match Tab Color to Cell Color
  For sht = 1 To 3
   For rw = 1 To 56
    If Sheets(sht).Tab.ColorIndex = Cells(rw, 1).Interior.ColorIndex Then
     Cells(rw, 2).Interior.ColorIndex = Sheets(sht).Tab.ColorIndex
    End If
   MsgBox "Corresponding Cells Should Match Tab Colors"
End Sub

Report •

February 12, 2010 at 06:57:01
I think its my deficiency to all things requiring common sense! Ive tried your recent code on a new sheet, this works fine, then used Humars code on same sheet where everything worked from your code, but his count still says 0 fo red green and orange, even whe nyour code works. It may be relevant to note in on excel 07

Report •

February 12, 2010 at 07:37:44

If you have applied colors using the ColorIndex you will need to use
dblClr = ws.Tab.ColorIndex

And change the three values in the Select - Case to the three ColorIndex numbers used.

If you add this:

        Case Else
        MsgBox "Sheet number " & ws.Index & " has color index #" & dblClr
    End Select
at the end of the Select Case structure you will get a message telling you if any sheet does not have one of your three colors.


Report •

February 12, 2010 at 08:22:13
This code should count your tabs by color without having to tell it what colors are in your workbook.

As written it assumes 3 colors, but it could be modified to count as many diffferent colors as you have.

Option Explicit
Sub TabClrCntDD03()
Dim ws As Worksheet
Dim clrIdx, nxtRw, thisIdx As Integer

'reset counters and colors in A2:B4
  ActiveSheet.Range("A2:A4").Interior.ColorIndex = -4142
'initialize row counter
   nxtRw = 2
'loop through ColorIndex Numbers and Worksheets
   For clrIdx = 1 To 56
    For Each ws In ActiveWorkbook.Worksheets()
'increment color counter when Tab Color matches ColorIndex
     If ws.Tab.ColorIndex = clrIdx Then _
       thisIdx = thisIdx + 1
    Next ws
'If a sheet tab matched a ColorIndex Value then
'Color cell in Column A and put counter in Column B
     If thisIdx > 0 Then
      Range("A" & nxtRw).Interior.ColorIndex = clrIdx
      Range("B" & nxtRw) = thisIdx
 'increment Row counter and reset ColorIndex counter
       nxtRw = nxtRw + 1
       thisIdx = 0
     End If
   Next clrIdx
End Sub

Report •

February 16, 2010 at 04:04:10
Hi guys,
Ive tried that code Derby and am pleased to say it gave me what I wanted, my thanks to you. I'll be opening one more thread this week to ask a question that seems to have been answered a few times without success for a few people.
Thanks again

Report •

Ask Question