Workbook tab Color count loop

Question

I need help with a loop to count all colored tabs in a workbook. I have 4 different colors, I would like to data to sum on the first tab of the workbook showing how many green, yellow...ect.

Public Sub

For Each mysheet in ActiveWorkbook.sheets
     If mysheet.tab.color = RGB(255,0,0) then
      mysheet.tab.count 
     End If
  Next mysheet
End Sub

This code was an experiment using code from another Macro, this is not a functioning code. I was thinking about a do while loop with counter?

NEW CODE:

Public Sub TabCount()
Dim x As Long, y As Long, z As Long, i As Long, O As Long
x = 0
y = 0
z = 0
i = 0
O = 0
For Each mysheet In ActiveWorkbook.Sheets
If mysheet.Tab.Color = RGB(0, 255, 0) Then
          x = x + 1
ElseIf mysheet.Tab.Color = RGB(255, 255, 0) Then
          y = y + 1
ElseIf mysheet.Tab.Color = RGB(255, 165, 0) Then
          z = z + 1
ElseIf mysheet.Tab.Color = RGB(255, 0, 0) Then
         i = i + 1
ElseIf mysheet.Tab.Color = RGB(0, 0, 255) Then
         O = O + 1
  End If
 
Next mysheet

'Need help here with pasting data.

End Sub

Answer 1

List Tab Colors Count

• Best tested in a copy of your workbook before getting familiar with it. It will write to the first (left-most) worksheet. Rather use the name (e.g. "Sheet1") instead of the index (1) when referencing it (dws).

Sub ListTabColors()

    Dim Headers() As Variant:
    Headers = VBA.Array("ID", "ColorNum", "Color", "Count")

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(1) ' improve!
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim ssh As Object, Color As Long
    
    For Each ssh In wb.Sheets
        Color = ssh.Tab.Color
        dict(Color) = dict(Color) + 1
    Next ssh
            
    Dim drCount As Long: drCount = dict.Count + 1
    Dim dcCount As Long: dcCount = UBound(Headers) + 1
    Dim drg As Range: Set drg = dws.Range("A2").Resize(drCount, dcCount)
    Dim Data() As Variant: ReDim Data(1 To drCount, 1 To dcCount)
    Dim r As Long: r = 1
    
    dws.UsedRange.Clear
    
    Dim Key As Variant, c As Long
    
    For c = 1 To dcCount
        Data(1, c) = Headers(c - 1)
    Next c
    
    For Each Key In dict.Keys
        r = r + 1
        Data(r, 1) = r - 1
        Data(r, 2) = Key
        drg.Cells(r, 3).Interior.Color = Key
        Data(r, 4) = dict(Key)
    Next Key
    
    With drg
        .Value = Data
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
    End With
     
    With dws.Range("A1")
        .Value = "Tab Colors"
        With .Font
            .Bold = True
            .Size = 14
        End With
    End With
    
    MsgBox "Tab colors count listed.", vbInformation
     
End Sub