Sub kojeBoje() Dim lRow As Long Dim iCntr As Long Dim boje(56) lRow = ActiveSheet.UsedRange.Rows.Count For iCntr = lRow To 1 Step -1 boje(ColorIndex(Cells(iCntr, 1))) = boje(ColorIndex(Cells(iCntr, 1))) + 1 Next iCntr Dim txt As String For iCntr = 0 To 56 If boje(iCntr) > 0 Then txt = txt & CStr(iCntr) & vbNewLine Next iCntr MsgBox txt End Sub '--------------------------------------------------------------------- ' ColorIndex Function '--------------------------------------------------------------------- ' Function: Returns the colorindex of the supplied range ' Synopsis: Initially, gets a colorindex value for black and white ' from the activeworkbook colour palette ' Then works through each cell in the supplied range and ' determines the colorindex, and adds to array ' Finishes by returning acumulated array ' Variations: Determines cell colour (interior) or text colour (font) ' Default is cell colour ' Constraints: Does not count colours set by conditional formatting '--------------------------------------------------------------------- ' Author: Bob Phillips ' Additions for ranges suggested by Harlan Grove '--------------------------------------------------------------------- '--------------------------------------------------------------------- Function ColorIndex(Rng As Range, _ Optional text As Boolean = False) As Variant '--------------------------------------------------------------------- Dim cell As Range, row As Range Dim i As Long, j As Long Dim iWhite As Long, iBlack As Long Dim aryColours As Variant If Rng.Areas.Count > 1 Then ColorIndex = CVErr(xlErrValue) Exit Function End If iWhite = WhiteColorindex(Rng.Worksheet.Parent) iBlack = BlackColorindex(Rng.Worksheet.Parent) If Rng.Cells.Count = 1 Then If text Then aryColours = DecodeColorIndex(Rng, True, iBlack) Else aryColours = DecodeColorIndex(Rng, False, iWhite) End If Else aryColours = Rng.Value i = 0 For Each row In Rng.Rows i = i + 1 j = 0 For Each cell In row.Cells j = j + 1 If text Then aryColours(i, j) = _ DecodeColorIndex(cell, True, iBlack) Else aryColours(i, j) = _ DecodeColorIndex(cell, False, iWhite) End If Next cell Next row End If ColorIndex = aryColours End Function '--------------------------------------------------------------------- Private Function WhiteColorindex(oWB As Workbook) '--------------------------------------------------------------------- Dim iPalette As Long WhiteColorindex = 0 For iPalette = 1 To 56 If oWB.Colors(iPalette) = &HFFFFFF Then WhiteColorindex = iPalette Exit Function End If Next iPalette End Function '--------------------------------------------------------------------- Private Function BlackColorindex(oWB As Workbook) '--------------------------------------------------------------------- Dim iPalette As Long BlackColorindex = 0 For iPalette = 1 To 56 If oWB.Colors(iPalette) = &H0 Then BlackColorindex = iPalette Exit Function End If Next iPalette End Function '--------------------------------------------------------------------- Private Function DecodeColorIndex(Rng As Range, _ text As Boolean, _ idx As Long) '--------------------------------------------------------------------- Dim iColor As Long If text Then iColor = Rng.Font.ColorIndex Else iColor = Rng.Interior.ColorIndex End If If iColor < 0 Then iColor = idx End If DecodeColorIndex = iColor End Function '--------------------------------------------------------------------- ' End of ColorIndex Function '---------------------------------------------------------------------