Counting by colour dilemma!!

[Simon Lloyd]

Hi Dave,

The code below is as it appears below nothing has been changed, th
formulae are in B5 and B6 respectively B5 returns the count by colou
for column A just fine but the CntByColor returns a value of 0 but o
step thru does not use the CntbyColor function it uses the first
lines and then uses the Count By Color its wierd!

Any suggestions?.....the functions are caled upon by the Auto_open

Simon

Sub Auto_open()

Dim ccount As Integer
Dim cccount As Integer
Application.DisplayAlerts = False
Application.DisplayFormulaBar = False


Range("B5").Select
ActiveCell.FormulaR1C1
"=COUNTBYCOLOR(R[9]C[-1]:R[484]C[-1],38,FALSE)"
Range("B7").Select
Range("d14").Select
ccount = Range("b5")
Range("B6").Select
ActiveCell.FormulaR1C1 = "=CntByColor(R[8]C[2]:R[485]C[33],38,FALSE)"
'Range("B7").Select
'Range("d14").Select
Range("B6") = cccount

Worksheets("holidays").Visible = True
Worksheets("Holiday Count").Visible = True
Worksheets("Xtra's & Count").Visible = True
Sheets("holidays").Activate
MsgBox "There Are " & ccount & " Holiday Clashes" & Chr(13) & "
There Have Been " & cccount & " accomodations", vbOKOnly, "Clash Count"


End Sub



Function CountByColor(InRange As Range, WhatColorIndex As Integer
Optional OfText As Boolean = False) As Long
Dim Rng As Range
Application.Volatile True

For Each Rng In InRange.Cells
If IsDate(Rng) Then
If OfText = True Then
CountByColor = CountByColor - _
(Rng.Font.ColorIndex = WhatColorIndex)
Else
CountByColor = CountByColor - _
(Rng.Interior.ColorIndex = WhatColorIndex)
End If
End If
Next Rng

End Function


Function CntByColor(InRange As Range, WhatColorIndex As Integer, _
Optional OfText As Boolean = False) As Long

Dim Rng1 As Range
Application.Volatile True
Rng1 = Range("D14:AI491")
For Each Rng1 In InRange.Cells
If Rng1.Value = "#N/A" Then
'do nothing
Else
If IsNumber = True Then
CntByColor = CntByColor - _
(Rng.Font.ColorIndex = WhatColorIndex)
Else
CntByColor = CntByColor - _
(Rng.Interior.ColorIndex = WhatColorIndex)
End If
End If

Next Rng1

End Functio

 

[Myrna Larson]

Presumably there is some logic to the application of the colors. You would
make your life a lot simpler, and your worksheet a lot faster to calculate, if
you put that logic into a formula in another column that returns 1 if the cell
is to be colored, then did your counts on that helper column.

As Earl Kiosterud mentions on his web site, you should NOT try to store
information in formatting. Excel was designed to interpret and manipulate
information that's stored as numbers or text.

 

[Dave Peterson]

I agree with everything Myrna suggested, but this version of cntbycolor compiled
and returned a value--I'm not sure if it's what you want, though:


Function CntByColor(InRange As Range, WhatColorIndex As Integer, _
Optional OfText As Boolean = False) As Long

Dim Rng1 As Range
Application.Volatile True
For Each Rng1 In InRange.Cells
If Rng1.Value = "#N/A" Then
'do nothing
Else
If IsNumeric(Rng1) = True Then
CntByColor = CntByColor - _
(Rng1.Font.ColorIndex = WhatColorIndex)
Else
CntByColor = CntByColor - _
(Rng1.Interior.ColorIndex = WhatColorIndex)
End If
End If
Next Rng1

End Function

Since you were passing the range to the function via InRange, I didn't see what
this line was supposed to do:


Rng1 = Range("D14:AI491")

In fact, since Rng1 is a range object, you'd have to use:

set rng1 = range("d14:ai491")

but the next line wants to use rng1 -- which makes this "set rng1= range()"
useless.

(Is it closer?)

And you may want to consider what Myrna/Earl say. It'll make your life simpler
if you can just inspect the data.

Hi Dave,

The code below is as it appears below nothing has been changed, the
formulae are in B5 and B6 respectively B5 returns the count by colour
for column A just fine but the CntByColor returns a value of 0 but on
step thru does not use the CntbyColor function it uses the first 3
lines and then uses the Count By Color its wierd!

Any suggestions?.....the functions are caled upon by the Auto_open

Simon

Sub Auto_open()

Dim ccount As Integer
Dim cccount As Integer
Application.DisplayAlerts = False
Application.DisplayFormulaBar = False

Range("B5").Select
ActiveCell.FormulaR1C1 =
"=COUNTBYCOLOR(R[9]C[-1]:R[484]C[-1],38,FALSE)"
Range("B7").Select
Range("d14").Select
ccount = Range("b5")
Range("B6").Select
ActiveCell.FormulaR1C1 = "=CntByColor(R[8]C[2]:R[485]C[33],38,FALSE)"
'Range("B7").Select
'Range("d14").Select
Range("B6") = cccount

Worksheets("holidays").Visible = True
Worksheets("Holiday Count").Visible = True
Worksheets("Xtra's & Count").Visible = True
Sheets("holidays").Activate
MsgBox "There Are " & ccount & " Holiday Clashes" & Chr(13) & "
There Have Been " & cccount & " accomodations", vbOKOnly, "Clash Count"

End Sub

Function CountByColor(InRange As Range, WhatColorIndex As Integer,
Optional OfText As Boolean = False) As Long
Dim Rng As Range
Application.Volatile True

For Each Rng In InRange.Cells
If IsDate(Rng) Then
If OfText = True Then
CountByColor = CountByColor - _
(Rng.Font.ColorIndex = WhatColorIndex)
Else
CountByColor = CountByColor - _
(Rng.Interior.ColorIndex = WhatColorIndex)
End If
End If
Next Rng

End Function

Function CntByColor(InRange As Range, WhatColorIndex As Integer, _
Optional OfText As Boolean = False) As Long

Dim Rng1 As Range
Application.Volatile True
Rng1 = Range("D14:AI491")
For Each Rng1 In InRange.Cells
If Rng1.Value = "#N/A" Then
'do nothing
Else
If IsNumber = True Then
CntByColor = CntByColor - _
(Rng.Font.ColorIndex = WhatColorIndex)
Else
CntByColor = CntByColor - _
(Rng.Interior.ColorIndex = WhatColorIndex)
End If
End If

Next Rng1

End Function