ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   A macro that counts cells when the conditional formatting formula =True. i.e. the cell is colored other than white. (https://www.excelbanter.com/excel-programming/412767-macro-counts-cells-when-conditional-formatting-formula-%3Dtrue-i-e-cell-colored-other-than-white.html)

R Tanner

A macro that counts cells when the conditional formatting formula =True. i.e. the cell is colored other than white.
 
I have a macro I got from someone that counts colored cells.
Unfortunately, it doesn't work with conditional formatting. Does
anyone know how to solve this so that I can run a macro that would
include conditional formatting? I am trying to determine the number
of cells in a row where the conditional formatting formula equals
true.

'---------------------------------------------------------------------
Function ColorIndex(rng As Integer, _
Optional text As Boolean = True)
'---------------------------------------------------------------------
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

Any help would be appreciated..

Mike H

A macro that counts cells when the conditional formatting formula
 
Hi,

have a look here but to quote the author, 'It's surprisingly difficult'

http://www.xldynamic.com/source/xld.CFConditions.html


Mike

"R Tanner" wrote:

I have a macro I got from someone that counts colored cells.
Unfortunately, it doesn't work with conditional formatting. Does
anyone know how to solve this so that I can run a macro that would
include conditional formatting? I am trying to determine the number
of cells in a row where the conditional formatting formula equals
true.

'---------------------------------------------------------------------
Function ColorIndex(rng As Integer, _
Optional text As Boolean = True)
'---------------------------------------------------------------------
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

Any help would be appreciated..


JLGWhiz

A macro that counts cells when the conditional formatting formula
 
One thing that I found in checking FormatConditions(1).Interior.ColorIndex is
that if will give you a true reading if the condition is set, but it does not
guarantee that the condition has been met with the color displayed. It only
tells you that the condition is set and the color it is set for. Maybe
someone knows a way around that quirk.

"R Tanner" wrote:

I have a macro I got from someone that counts colored cells.
Unfortunately, it doesn't work with conditional formatting. Does
anyone know how to solve this so that I can run a macro that would
include conditional formatting? I am trying to determine the number
of cells in a row where the conditional formatting formula equals
true.

'---------------------------------------------------------------------
Function ColorIndex(rng As Integer, _
Optional text As Boolean = True)
'---------------------------------------------------------------------
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

Any help would be appreciated..


Bob Phillips[_3_]

A macro that counts cells when the conditional formatting formula
 
If you follow that link that Mike H gave, you will see how.

--
__________________________________
HTH

Bob

"JLGWhiz" wrote in message
...
One thing that I found in checking FormatConditions(1).Interior.ColorIndex
is
that if will give you a true reading if the condition is set, but it does
not
guarantee that the condition has been met with the color displayed. It
only
tells you that the condition is set and the color it is set for. Maybe
someone knows a way around that quirk.

"R Tanner" wrote:

I have a macro I got from someone that counts colored cells.
Unfortunately, it doesn't work with conditional formatting. Does
anyone know how to solve this so that I can run a macro that would
include conditional formatting? I am trying to determine the number
of cells in a row where the conditional formatting formula equals
true.

'---------------------------------------------------------------------
Function ColorIndex(rng As Integer, _
Optional text As Boolean = True)
'---------------------------------------------------------------------
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

Any help would be appreciated..




JLGWhiz

A macro that counts cells when the conditional formatting form
 
Hi Bob, you worked up some good code there, but it seems like a lot of extra
work when checking the cell values could provide the same results in most
cases. If the interior turns red for the value of 5, then check for the
value of 5 in the cell and consider it as a red cell. Maybe I am over
simplifying, but then I have never needed to get into it that deep.

"Bob Phillips" wrote:

If you follow that link that Mike H gave, you will see how.

--
__________________________________
HTH

Bob

"JLGWhiz" wrote in message
...
One thing that I found in checking FormatConditions(1).Interior.ColorIndex
is
that if will give you a true reading if the condition is set, but it does
not
guarantee that the condition has been met with the color displayed. It
only
tells you that the condition is set and the color it is set for. Maybe
someone knows a way around that quirk.

"R Tanner" wrote:

I have a macro I got from someone that counts colored cells.
Unfortunately, it doesn't work with conditional formatting. Does
anyone know how to solve this so that I can run a macro that would
include conditional formatting? I am trying to determine the number
of cells in a row where the conditional formatting formula equals
true.

'---------------------------------------------------------------------
Function ColorIndex(rng As Integer, _
Optional text As Boolean = True)
'---------------------------------------------------------------------
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

Any help would be appreciated..





Bob Phillips[_3_]

A macro that counts cells when the conditional formatting form
 
You are correct of course, but the code is a one off that works in all
cases. If you have many different CFs with different conditions, you have to
replicate them all, and if they change ... The code is a workable solution
if it helps, and of course it is done, it is just a cut and paste.

--
__________________________________
HTH

Bob

"JLGWhiz" wrote in message
...
Hi Bob, you worked up some good code there, but it seems like a lot of
extra
work when checking the cell values could provide the same results in most
cases. If the interior turns red for the value of 5, then check for the
value of 5 in the cell and consider it as a red cell. Maybe I am over
simplifying, but then I have never needed to get into it that deep.

"Bob Phillips" wrote:

If you follow that link that Mike H gave, you will see how.

--
__________________________________
HTH

Bob

"JLGWhiz" wrote in message
...
One thing that I found in checking
FormatConditions(1).Interior.ColorIndex
is
that if will give you a true reading if the condition is set, but it
does
not
guarantee that the condition has been met with the color displayed. It
only
tells you that the condition is set and the color it is set for. Maybe
someone knows a way around that quirk.

"R Tanner" wrote:

I have a macro I got from someone that counts colored cells.
Unfortunately, it doesn't work with conditional formatting. Does
anyone know how to solve this so that I can run a macro that would
include conditional formatting? I am trying to determine the number
of cells in a row where the conditional formatting formula equals
true.

'---------------------------------------------------------------------
Function ColorIndex(rng As Integer, _
Optional text As Boolean = True)
'---------------------------------------------------------------------
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

Any help would be appreciated..








All times are GMT +1. The time now is 03:38 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com