I'm helping a colleague solve a time consuming problem by writing them a UDF.

The UDF shown below takes a string, searches each cell in a range, and builds a comma separated list of all the cell values (in a correspoinding range) containing the search string. The result string is stored in the function's cell.

The function works, but for a long lookup list (40,000 rows) it takes a number of seconds to recalculate a single formula using the function.

I'm hoping for suggestions on how to speed the function up, as we'd need to copy the function across a couple of hundred cells.

Thx

Example:

A1 Bottom

A2 Top

A3 Tomorrow

A4 Today

A5 Atombomb

Formula: =SearchList("Tom", A1:A5)

Result: Bottom, Tomorrow, Atombomb

Public Function SearchList(strSearch As String, _

rngLookup As Range, _

Optional rngValues As Range) As String

'This function uses a search value to search a range of cell values for a match,

'and if a match is found a value is appended to a comma separated string.

'

'This function is passed 3 parameters:

' 1) a search string, used to search the value in each cell in a lookup range;

' 2) a cell range of values to lookup; and

' 3) a cell range of the values to store when a match is made to a lookup cell

'If the Lookup and value ranges are the same, the rngValues parameter can be

'omitted.

'===============================================================================

Dim r As Long 'number of rows in the range

Dim c As Long 'number of columns in the range

Dim n As Long 'number of cells in the range

Dim i As Long 'loop counters for rows

Dim j As Long 'loop counter for columns

Dim rng As Range 'lookup range

If rngValues Is Nothing Then

Set rng = rngLookup

Else

Set rng = rngValues

End If

If rngLookup.Cells.Count <> rng.Cells.Count Then

SearchList = "Range Error!"

Exit Function

End If

'initialise variables

r = rngLookup.Rows.Count

c = rngLookup.Columns.Count

n = r * c

SearchList = ""

For i = 1 To r

For j = 1 To c

'check to make sure the cell has a value to add to the list

If Not IsEmpty(rngLookup.Cells(i, j).Value) And _

InStr(1, UCase(rngLookup.Cells(i, j).Text), UCase(strSearch)) Then

If Len(SearchList) > 0 Then

'add a comma after the existing string for all items after the first

SearchList = SearchList & ", "

End If

SearchList = SearchList & Format(rng.Cells(i, j).Value, "@")

End If

Next j

Next i

End Function 'SearchList