Help to speed up UDF (if is possible)

[davidmg1982]

Hi all, its my first day at work and par of it is to run a formula based on a UDF, which search for a value within a cell text string based on a column list, this list is almost 25000 rows. Since its searching for this many words in almost 35000 text strings, it takes about 40 min, which is honestly fine for the amount of work, but i would appreciate if any of you kind people take a look and sugest any posible improvement to the function to speed the process. Thanks in advance for your kind help.

Example of the formula since i cannot attach an example doc.
B2=ExtractServer(A2,Sheet2!$A$1:$A$22804)

Function ExtractServer(SearchRange As Range, DogRange As Range) As String
 For Each Myrange In DogRange
  If InStr(1, SearchRange.Value, Myrange) > 0 Then ExtractServer = Myrange
 Next
End Function

 

[Rick Rothstein]

Hi all, its my first day at work and par of it is to run a formula based on a UDF, which search for a value within a cell text string based on a column list, this list is almost 25000 rows. Since its searching for this many words in almost 35000 text strings, it takes about 40 min, which is honestly fine for the amount of work, but i would appreciate if any of you kind people take a look and sugest any posible improvement to the function to speed the process. Thanks in advance for your kind help.

Example of the formula since i cannot attach an example doc.
B2=ExtractServer(A2,Sheet2!$A$1:$A$22804)

Function ExtractServer(SearchRange As Range, DogRange As Range) As String
 For Each Myrange In DogRange
  If InStr(1, SearchRange.Value, Myrange) > 0 Then ExtractServer = Myrange
 Next
End Function
[code][/QUOTE]
What exactly is this function supposed to be returning. It appears that DogRange is multi-celled and, of course, so it SearchRange. If that is the case, then no matter how many words in DogRange are found, the function only returns the last one. Is that correct? Am I reading your code correctly? If not, please explain what your function is attempting to do.

 

[davidmg1982]

Thanks Rick, you are correct, its returning the last value, look at the examples below:

Text string:

9 PMCLCAP JOB PMCLCAP CODA INBOUND PROD 445AM ON XLPFTP02 HAS ABENDED JOB 8863 PLEASE INVESTIGATE KB0020759 XLPFTP02NEW Values to be found: Row 195: XLPFTP02 Row 196: XLPFTP02NEW

<tbody>
</tbody>

UDF Result: XLPFTP02NEW


Our dream result will be: XLPFTP02, XLPFTP02NEW

But if we can improve what we already have will be wonderful, thanks again.

 

[Rick Rothstein]

[/B]Our dream result will be: XLPFTP02, XLPFTP02NEW

But if we can improve what we already have will be wonderful, thanks again.

You should always ask for what you ultimately want. So it looks like you ultimately want a list of all DogRange names found in the SearchNames list. Is that correct? If so, how did you want it presented... as a comma delimited list as shown (seems like that could potentially be too long a text string for a cell to hold) or a columnar list with one DogRange name per cell?

Also, can there be more than one of the same name in the DogRange list and, if so and if they matched, did you want both of them or only one of them shown?

 

[Rick Rothstein]

You should always ask for what you ultimately want. So it looks like you ultimately want a list of all DogRange names found in the SearchNames list. Is that correct? If so, how did you want it presented... as a comma delimited list as shown (seems like that could potentially be too long a text string for a cell to hold) or a columnar list with one DogRange name per cell?

Also, can there be more than one of the same name in the DogRange list and, if so and if they matched, did you want both of them or only one of them shown?

While I am waiting for the answers to my two questions in Message #4 above, here is a replacement for the code you posted in Message #1 which should return the last matching name in DogRange and do so noticeably faster than you are reporting for your posted code...

[table="width: 500"]
[tr]
	[td]Function ExtractServer(SearchRange As Range, DogRange As Range) As String
  Dim R As Long, Dogs As Variant, DogName As String
  Dogs = DogRange
  On Error Resume Next
  For R = UBound(Dogs) To 1 Step -1
    DogName = SearchRange.Find(Dogs(R, 1), , , xlWhole, , , False, , False)
    If Len(DogName) Then
      ExtractServer = DogName
      Exit Function
    End If
  Next
End Function[/td]
[/tr]
[/table]

 

[davidmg1982]

You should always ask for what you ultimately want. So it looks like you ultimately want a list of all DogRange names found in the SearchNames list. Is that correct? If so, how did you want it presented... as a comma delimited list as shown (seems like that could potentially be too long a text string for a cell to hold) or a columnar list with one DogRange name per cell?

Also, can there be more than one of the same name in the DogRange list and, if so and if they matched, did you want both of them or only one of them shown?

Thanks Rick, what we are looking to have is the following results, we just have 2 scenarios:

SearchNames is not a list, its a cell with a text string like this:

CELL F2: 9 PMCLCAP JOB PMCLCAP CODA INBOUND PROD 445AM ON XLPFTP02 HAS ABENDED JOB 8863 PLEASE INVESTIGATE KB0020759 XLPFTP02NEW Dogrange is a list with about 25000 rows with a single value like the ones below: Column A Row 1: XLPFTP01 Row 195: XLPFTP02 Row 196: XLPFTP02NEW Row 196: etc...

<tbody>
</tbody>

UDF Result expected, and not limited to a UDF it can be also a Sub () if necessary.

Example with UDF:
Cell F2: 9 PMCLCAP JOB PMCLCAP CODA INBOUND PROD 445AM ON XLPFTP02 HAS ABENDED JOB 8863 PLEASE INVESTIGATE KB0020759
Cell H2: =ExtractServer(H2,Dogrange!$A$1:$A$22804) UDF result: XLPFTP02

Cell F3: 9 PMCLCAP JOB PMCLCAP CODA INBOUND PROD 445AM ON XLPFTP02 HAS ABENDED JOB 8863 PLEASE INVESTIGATE KB0020759 XLPFTP02new
Cell H3: =ExtractServer(H3,Dogrange!$A$1:$A$22804) UDF result: XLPFTP02, XLPFTP02new

SearchNames is around 35,000 cells with a text string
Dogrange is around 25,000 cells with a value.
SearchNames text string never contain more than 2 Dogrange values.

 

[davidmg1982]

One last detail I missed, SearchName and Dogrange are daily reports we download so the total amount of rows may vary, but its always found in the same columns.

 

[Rick Rothstein]

One last detail I missed, SearchName and Dogrange are daily reports we download so the total amount of rows may vary, but its always found in the same columns.

I have no idea how fast this will be with your data because I did not test it on a layout anywhere near as extensive as you have indicated you have; however, I endeavored to make the code as efficient as I could think to do. I used you posted example as a basis, so I have your DogRange in Column A starting on Row 1 and your SearchRange in Column F starting on Row 2... the results are outputted to Column H starting on Row 2 (to match the layout for SearchRange). Note that I also took you at your word when you said there would never be more than 2 DogRange names in any one SearchRange cell (I deliberately stop looking if I have found to such names and move on to the next SearchMe cell). See if this code does what you want and, if so, give us an indication as to how fast it was.

[table="width: 500"]
[tr]
	[td]Sub ExtractServerSubroutine()
  Dim Rdogs As Long, Rsearch As Long, DogCount As Long
  Dim Dogs As Variant, SearchMe As Variant, Result As Variant
  Dogs = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  SearchMe = Range("F2", Cells(Rows.Count, "F").End(xlUp))
  ReDim Result(1 To UBound(SearchMe), 1 To 1)
  For Rsearch = 1 To UBound(SearchMe)
    DogCount = 0
    For Rdogs = 1 To UBound(Dogs)
      If InStr(1, SearchMe(Rsearch, 1), Dogs(Rdogs, 1), vbTextCompare) Then
        Result(Rsearch, 1) = Result(Rsearch, 1) & ", " & Dogs(Rdogs, 1)
        If Left(Result(Rsearch, 1), 1) = "," Then Result(Rsearch, 1) = Mid(Result(Rsearch, 1), 3)
        DogCount = DogCount + 1
        If DogCount = 2 Then Exit For
      End If
    Next
  Next
  Columns("H").Clear
  Range("H2").Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]

 

[Rick Rothstein]

I have no idea how fast this will be with your data because I did not test it on a layout anywhere near as extensive as you have indicated you have; however, I endeavored to make the code as efficient as I could think to do. I used you posted example as a basis, so I have your DogRange in Column A starting on Row 1 and your SearchRange in Column F starting on Row 2... the results are outputted to Column H starting on Row 2 (to match the layout for SearchRange). Note that I also took you at your word when you said there would never be more than 2 DogRange names in any one SearchRange cell (I deliberately stop looking if I have found to such names and move on to the next SearchMe cell). See if this code does what you want and, if so, give us an indication as to how fast it was.

[table="width: 500"]
[tr]
	[td]Sub ExtractServerSubroutine()
  Dim Rdogs As Long, Rsearch As Long, DogCount As Long
  Dim Dogs As Variant, SearchMe As Variant, Result As Variant
  Dogs = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  SearchMe = Range("F2", Cells(Rows.Count, "F").End(xlUp))
  ReDim Result(1 To UBound(SearchMe), 1 To 1)
  For Rsearch = 1 To UBound(SearchMe)
    DogCount = 0
    For Rdogs = 1 To UBound(Dogs)
      If InStr(1, SearchMe(Rsearch, 1), Dogs(Rdogs, 1), vbTextCompare) Then
        Result(Rsearch, 1) = Result(Rsearch, 1) & ", " & Dogs(Rdogs, 1)
        If Left(Result(Rsearch, 1), 1) = "," Then Result(Rsearch, 1) = Mid(Result(Rsearch, 1), 3)
        DogCount = DogCount + 1
        If DogCount = 2 Then Exit For
      End If
    Next
  Next
  Columns("H").Clear
  Range("H2").Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]

Same introductory text, but I need to make a minor modification in one of the code lines in order to make sure the code does not pick up any positives when examining if the DogRange name appears in a SearchRange cell or not. I highlighted the row I changed in red in case you want to examine what I did.

[table="width: 500"]
[tr]
	[td]Sub ExtractServerSubroutine()
  Dim Rdogs As Long, Rsearch As Long, DogCount As Long
  Dim Dogs As Variant, SearchMe As Variant, Result As Variant
  Dogs = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  SearchMe = Range("F2", Cells(Rows.Count, "F").End(xlUp))
  ReDim Result(1 To UBound(SearchMe), 1 To 1)
  For Rsearch = 1 To UBound(SearchMe)
    DogCount = 0
    For Rdogs = 1 To UBound(Dogs)
      [B][COLOR="#FF0000"]If InStr(1, " " & SearchMe(Rsearch, 1) & " ", " " & Dogs(Rdogs, 1) & " ", vbTextCompare) Then[/COLOR][/B]
        Result(Rsearch, 1) = Result(Rsearch, 1) & ", " & Dogs(Rdogs, 1)
        If Left(Result(Rsearch, 1), 1) = "," Then Result(Rsearch, 1) = Mid(Result(Rsearch, 1), 3)
        DogCount = DogCount + 1
        If DogCount = 2 Then Exit For
      End If
    Next
  Next
  Columns("H").Clear
  Range("H2").Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]

 

[davidmg1982]

Thanks Rick, i tested the sub routine with a few amount of data and is actually working, providing the result expected, unfortunately with the full load of data is taking more than the time we currently have with the UDF.

Talking with my team mates this morning we agree that its very rare that two values from DogRange are present in SearchNames, and we are fine if the result its the first value found in the text string. If this may help to make the search faster
And if this can be achieved with a User Define Function will be the best since we can mixed up with some other formulas and condition, but if the SubRoutines is the quickiest way we are also ok with that.
This is the last effort we ask from you, we dont want you to spend more of you valuable time on this, we are very thankful for your help.

Cell F3:

9 PMCLCAP JOB PMCLCAP CODA INBOUND PROD 445AM ON XLPFTP02 HAS ABENDED JOB 8863 PLEASE INVESTIGATE KB0020759 XLPFTP02NEW

<tbody>
</tbody>

Cell H3:
=ExtractServer(H3,Dogrange!$A$1:$A$22804) UDF result: XLPFTP02

Heres an example file of the data:
https://swa.box.com/s/r23huvpoi4r2pzkobybkysulyvrx6oi4