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

why not just use COUNTIF?

--
Don Guillett
SalesAid Software
(E-Mail Removed)
"Sisilla" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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
>

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

That one scared me.

The OP wants the range returned--not just the count.

Don Guillett wrote:
>
> why not just use COUNTIF?
>
> --
> Don Guillett
> SalesAid Software
> (E-Mail Removed)
> "Sisilla" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > 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

Hello Don,

Thank you for your efforts to help me. I am afraid that I don't
understand how CountIf will save me iterations within the For loop.

I can count the number of cells in the range that are greater than
CompareValue, but won't I still have to compare each cell in the range,
or am i missing something?

I appreciate any further help.

Thanks,
Sisilla

Don Guillett wrote:
> why not just use COUNTIF?
>
> --
> Don Guillett
> SalesAid Software
> (E-Mail Removed)
> "Sisilla" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > 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
> >

After reading Don's reply, you could use his check to know when to quit looking:

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

Dim HowMany As Long
Dim myCount As Long

Dim myNumConst As Range
Dim myNumFormulas As Range
Dim myNumCells As Range
Dim TotalRng As Range
Dim rCell As Range

HowMany = Application.CountIf(SearchRange, ">=" & CompareValue)

If HowMany = 0 Then
'return nothing and get out
Set AtLeastCells = Nothing
Exit Function
End If

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
'shouldn't get here, since we know there's at least one match
Else
myCount = 0
Set TotalRng = Nothing
For Each rCell In myNumCells.Cells
If rCell.Value >= CompareValue Then
myCount = myCount + 1
If TotalRng Is Nothing Then
Set TotalRng = rCell
Else
Set TotalRng = Union(rCell, TotalRng)
End If
If myCount = HowMany Then
'done looking
Exit For
End If
End If
Next rCell
End If

Set AtLeastCells = TotalRng

End Function

(Untested, but it did compile)

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

--

Dave Peterson

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

Dave,

I cannot express how thankful I am to you. I greatly appreciate your
time and effort.

Now that you've explained it, I see how helpful CountIf can be in
saving iterations, especially if there is no instance in SearchRange
greater than CompareValue and also if the instances are closer to the
top of the range. I will definitely try out your new suggestions.

Again Thanks,
Sisilla

Dave Peterson wrote:
> After reading Don's reply, you could use his check to know when to quit looking:
>
> Option Explicit
> Function AtLeastCells(CompareValue As Integer, SearchRange As Range) As Range
>
> Dim HowMany As Long
> Dim myCount As Long
>
> Dim myNumConst As Range
> Dim myNumFormulas As Range
> Dim myNumCells As Range
> Dim TotalRng As Range
> Dim rCell As Range
>
> HowMany = Application.CountIf(SearchRange, ">=" & CompareValue)
>
> If HowMany = 0 Then
> 'return nothing and get out
> Set AtLeastCells = Nothing
> Exit Function
> End If
>
> 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
> 'shouldn't get here, since we know there's at least one match
> Else
> myCount = 0
> Set TotalRng = Nothing
> For Each rCell In myNumCells.Cells
> If rCell.Value >= CompareValue Then
> myCount = myCount + 1
> If TotalRng Is Nothing Then
> Set TotalRng = rCell
> Else
> Set TotalRng = Union(rCell, TotalRng)
> End If
> If myCount = HowMany Then
> 'done looking
> Exit For
> End If
> End If
> Next rCell
> End If
>
> Set AtLeastCells = TotalRng
>
> End Function
>
> (Untested, but it did compile)
>
> 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
>
> --
>
> Dave Peterson

You have answers to your main question but just to add, if your
'AtLeastCells' cells will exist in many non-contiguous areas your union loop
will become exponentially slower, eventually to a crawl. If that's a
possibility consider not making a single large multi area range object and
processing in a different way. Eg make an array of string addresses for
later use, or process intermediate range objects that exceed say 100 areas.

Regards,
Peter T


"Sisilla" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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
>

Hello Peter,

Thanks for your reply. Are you saying that it would be faster to
concatenate strings with every iteration of the loop than to union
non-contiguous ranges?

If this is indeed what you are saying, then I will have to find some
way to convert the returned string back to a range once it is needed
(in the Copy method). Thank you for your advice.

Sisilla

Peter T wrote:
> You have answers to your main question but just to add, if your
> 'AtLeastCells' cells will exist in many non-contiguous areas your union loop
> will become exponentially slower, eventually to a crawl. If that's a
> possibility consider not making a single large multi area range object and
> processing in a different way. Eg make an array of string addresses for
> later use, or process intermediate range objects that exceed say 100 areas.
>
> Regards,
> Peter T
>
>
> "Sisilla" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > 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
> >