View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Sisilla[_2_] Sisilla[_2_] is offline
external usenet poster
 
Posts: 34
Default CountIf Greater Than/Find Greater Than

Hello Dave,

Your suggestions are very helpful. I won't be using the function as a
worksheet formula. The SeachRange will always be in the number format,
but there are many instances when I expect many empty cells within the
range. I will try your suggestion of skipping empty cells. Thanks very
much. I appreciate it.

Sisilla

Dave Peterson wrote:
Will this function ever be called from a worksheet formula?

If yes, then this won't work.

If no, then maybe just looping through the cells that contain numbers would be
quicker (skipping empty cells, text cells):

Dim myNumConst As Range
Dim myNumFormulas As Range
Dim myNumCells As Range

Set myNumCells = Nothing
Set myNumConst = Nothing
Set myNumFormulas = Nothing
On Error Resume Next
Set myNumConst _
= SearchRange.Cells.SpecialCells(xlCellTypeConstants , xlNumbers)
Set myNumFormulas _
= SearchRange.Cells.SpecialCells(xlCellTypeFormulas, xlNumbers)
On Error GoTo 0

If myNumConst Is Nothing Then
Set myNumCells = myNumFormulas
Else
If myNumFormulas Is Nothing Then
Set myNumCells = myNumConst
Else
Set myNumCells = Union(myNumConst, myNumFormulas)
End If
End If

If myNumCells Is Nothing Then
'return nothing
Else
'do the work against the smaller range
For Each rCell In myNumCells.Cells
'...
next rCell
End If

==========
But if that whole search range is numbers, then this won't help.

Sisilla wrote:

Hello All,

The following code runs slowly. Is there a better way to do this,
perhaps with CountIf and Find? If there is even the smallest
improvement from comparing every cell in the SearchRange with
CompareValue, I'd love to hear the solution!

Function AtLeastCells(CompareValue As Integer, SearchRange As Range) As
Range

'Searches SearchRange for values that are greater than or equal to
CompareValue
'of Integer Data Type.
'If values are found, all matching cells are returned.
'If no value is found, an empty range is returned.

Dim rCell As Range

For Each rCell In SearchRange.Cells
If rCell.Value = CompareValue Then
Set AtLeastCells = UnionWithNothing(rCell, AtLeastCells)
End If
Next rCell

End Function

I greatly appreciate any help.

Thanks!
Sisilla


--

Dave Peterson