Hi,
I have some code that counts cells with specific color, now I also
want to count all cells with diagonal borders. The cell color count
VBA is below...

Function CellColorIndex(InRange As Range, Optional _
OfText As Boolean = False) As Integer
'
' This function returns the ColorIndex value of a the Interior
' (background) of a cell, or, if OfText is true, of the Font in the
cell.
'
Application.Volatile True
If OfText = True Then
CellColorIndex = InRange(1, 1).Font.ColorIndex
Else
CellColorIndex = InRange(1, 1).Interior.ColorIndex
End If


End Function


Function CountByColor(InRange As Range, _
WhatColorIndex As Integer, _
Optional OfText As Boolean = False) As Long
'
' This function return the number of cells in InRange with
' a background color, or if OfText is True a font color,
' equal to WhatColorIndex.
'
Dim Rng As Range
Application.Volatile True


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


End Function


any help is appreciated as usual...thankyou.

See answer from Sept 11th

http://tinyurl.com/6b222hv



Gord Dibben Microsoft Excel MVP

On Sat, 24 Sep 2011 19:07:20 -0700 (PDT), jt <(E-Mail Removed)>
wrote:

>Hi,
>I have some code that counts cells with specific color, now I also
>want to count all cells with diagonal borders. The cell color count
>VBA is below...
>
>Function CellColorIndex(InRange As Range, Optional _
> OfText As Boolean = False) As Integer
>'
>' This function returns the ColorIndex value of a the Interior
>' (background) of a cell, or, if OfText is true, of the Font in the
>cell.
>'
>Application.Volatile True
>If OfText = True Then
> CellColorIndex = InRange(1, 1).Font.ColorIndex
>Else
> CellColorIndex = InRange(1, 1).Interior.ColorIndex
>End If
>
>
>End Function
>
>
>Function CountByColor(InRange As Range, _
> WhatColorIndex As Integer, _
> Optional OfText As Boolean = False) As Long
>'
>' This function return the number of cells in InRange with
>' a background color, or if OfText is True a font color,
>' equal to WhatColorIndex.
>'
>Dim Rng As Range
>Application.Volatile True
>
>
>For Each Rng In InRange.Cells
>If OfText = True Then
> CountByColor = CountByColor - _
> (Rng.Font.ColorIndex = WhatColorIndex)
>Else
> CountByColor = CountByColor - _
> (Rng.Interior.ColorIndex = WhatColorIndex)
>End If
>Next Rng
>
>
>End Function
>
>
>any help is appreciated as usual...thankyou.
>
>

On Sep 24, 10:20*pm, Gord <phnor...@shaw.ca> wrote:
> See answer from Sept 11th
>
> http://tinyurl.com/6b222hv
>
> Gord Dibben * *Microsoft Excel MVP
>
> On Sat, 24 Sep 2011 19:07:20 -0700 (PDT), jt <kijij...@gmail.com>
> wrote:
>
>
>
> >Hi,
> >I have some code that counts cells with specific color, now I also
> >want to count all cells with diagonal borders. The cell color count
> >VBA is below...
>
> >Function CellColorIndex(InRange As Range, Optional _
> > * *OfText As Boolean = False) As Integer
> >'
> >' This function returns the ColorIndex value of a the Interior
> >' (background) of a cell, or, if OfText is true, of the Font in the
> >cell.
> >'
> >Application.Volatile True
> >If OfText = True Then
> > * *CellColorIndex = InRange(1, 1).Font.ColorIndex
> >Else
> > * *CellColorIndex = InRange(1, 1).Interior.ColorIndex
> >End If
>
> >End Function
>
> >Function CountByColor(InRange As Range, _
> > * *WhatColorIndex As Integer, _
> > * *Optional OfText As Boolean = False) As Long
> >'
> >' This function return the number of cells in InRange with
> >' a background color, or if OfText is True a font color,
> >' equal to WhatColorIndex.
> >'
> >Dim Rng As Range
> >Application.Volatile True
>
> >For Each Rng In InRange.Cells
> >If OfText = True Then
> > * *CountByColor = CountByColor - _
> > * * * * * *(Rng.Font.ColorIndex = WhatColorIndex)
> >Else
> > * *CountByColor = CountByColor - _
> > * * * (Rng.Interior.ColorIndex = WhatColorIndex)
> >End If
> >Next Rng
>
> >End Function
>
> >any help is appreciated as usual...thankyou.- Hide quoted text -
>
> - Show quoted text -

this works, thankyou

attention this formula does not automatically recalculate if you delete or add a diagonal in the range of target cells

--
isabelle



Le 2011-09-25 19:55, jt a écrit :

> this works, thankyou