Sub ko****je()
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
'---------------------------------------------------------------------