CODEWITHSUNDEEP
vbaexcelexcel-formulauser-defined-functions
Enrico
Enrico

Reputation: 188

better performance in an Excel UDF with IF or Select Case

I need often to search in Excel with formulas for some special texts in a cell. The number of rows i need to search are 100.000 to 500.000, in rare case up to 1.000.000. To avoid long formulas i wrote a own UDF to search for multiple text strings in a cell. The new formula is short to handle. I optimize the runtime of this formula as good as i can. It needs 11 to 12 sec for 500.000 rows.

I made this formula in two ways: one uses IF-Statement (SuchenSIF), the other (SuchenSSELCASE) use SELECT CASE Statements. Booth formulas have the same speed. Can you give me some hint how to get a better performance?

Syntax of this formula is:
SuchenSIF(cell to search, text to search 1, ... text to search 6)
SuchenSSELCASE(cell to search, text to search 1, ... text to search 6) 

Public Function SuchenSIF(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer
Application.Volatile

' this code, based on IF-statements need 11-12 seconds for 500.000 rows
' Start of IF-Section
'
ZelleWert = Zelle.Value
SuchenS = InStr(1, ZelleWert, such1, vbTextCompare)
If SuchenS > 0 Then Exit Function
SuchenS = InStr(1, ZelleWert, such2, vbTextCompare)
If SuchenS <> vbFalse Then Exit Function
If Len(such3) > 0 Then
    SuchenS = InStr(1, ZelleWert, such3, vbTextCompare)
    If SuchenS > 0 Then Exit Function
    If Len(such4) > 0 Then
        SuchenS = InStr(1, ZelleWert, such4, vbTextCompare)
        If SuchenS > 0 Then Exit Function
        If Len(such5) > 0 Then
            SuchenS = InStr(1, ZelleWert, such5, vbTextCompare)
            If SuchenS > 0 Then Exit Function
            If Len(such6) > 0 Then
                SuchenS = InStr(1, ZelleWert, such6, vbTextCompare)
                If SuchenS > 0 Then Exit Function
            End If
        End If
    End If
End If
'
' End of IF-Section
If SuchenS = 0 Then SuchenS = False
End Function

Public Function SuchenSSELCASE(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer
Application.Volatile
' this code, based on SELECT-CASE-statements need 11-12 seconds for 500.000 rows
' Start of SELECT-CASE -Section
'
ZelleWert = Zelle.Value
SuchenS = InStr(1, ZelleWert, such1, vbTextCompare) * Len(such1)
Select Case SuchenS
    Case 0
        SuchenS = InStr(1, ZelleWert, such2, vbTextCompare) * Len(such2)
        Select Case SuchenS
            Case 0
                SuchenS = InStr(1, ZelleWert, such3, vbTextCompare) * Len (such3)
                Select Case SuchenS
                    Case 0
                        SuchenS = InStr(1, ZelleWert, such4, vbTextCompare) * Len(such4)
                        Select Case SuchenS
                            Case 0
                                SuchenS = InStr(1, ZelleWert, such5, vbTextCompare) * Len(such5)
                                Select Case SuchenS
                                    Case 0
                                        SuchenS = InStr(1, ZelleWert, such6, vbTextCompare) * Len(such6)
                                        Select Case SuchenS
                                            Case 0
                                            Case Else
                                                SuchenS = SuchenS / Len(such6)
                                                Exit Function
                                        End Select
                                    Case Else
                                        SuchenS = SuchenS / Len(such5)
                                        Exit Function
                                End Select
                            Case Else
                                SuchenS = SuchenS / Len(such4)
                                Exit Function
                        End Select
                    Case Else
                        SuchenS = SuchenS / Len(such3)
                        Exit Function
                End Select
            Case Else
                SuchenS = SuchenS / Len(such2)
                Exit Function
        End Select
    Case Else
        SuchenS = SuchenS / Len(such1)
        Exit Function
End Select
'
' End of SELECT-CASE -Section
If SuchenS = 0 Then SuchenS = False
End Function

Upvotes: 4

Views: 986

Answers (3)

Shai Rado
Shai Rado

Reputation: 33692

You have not provided any data how you use this Function and what you are trying to achieve. Maybe we can replace your entire Function concept with something shorter and faster.

Edit: removed the previous concept, and decided to use this version with Application.Match.

Public Function SuchenSIF(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer
        
    Dim suchArr() As String, Elem As Variant

    ReDim suchArr(0 To 5)

    ' create suchArr with only such arguments that are none-blank
    For Each Elem In Array(such1, such2, such3, such4, such5, such6)
        If Elem <> vbNullString Then
            suchArr(i) = Elem
            i = i + 1
        End If
    Next Elem
    
    ReDim Preserve suchArr(0 To i - 1) ' resize to actual populated array size
    
    ' use Match to get the index of the array that is matched
    SuchenSIF = Application.Match(Zelle.Value, suchArr, 0) - 1
    
    If IsError(SuchenSIF) Then SuchenSIF = -10000  ' Just to Raise some kind of error "NOT found!"
           
End Function

Upvotes: 0

CallumDA
CallumDA

Reputation: 12113

You could create an array containing only the parameters which have been passed to the function and loop through that for a bit of a speed gain (...I think)

Public Function SuchenSIF(Zelle As Range, such1 As String, Optional such2 As String, Optional such3 As String, Optional such4 As String, Optional such5 As String, Optional such6 As String) As Integer
    Application.Volatile

    Dim possibleInputs As Variant, v As Variant, inputs As Variant
    Dim i As Integer
    Dim ZelleWert As String

    possibleInputs = Array(such2, such3, such4, such5, such6)

    'create an array of non-empty parameters
    ReDim inputs(0 To 0)
    inputs(0) = such1
    For i = 0 To 4
        If possibleInputs(i) <> vbNullString Then
            ReDim Preserve inputs(0 To UBound(inputs) + 1)
            inputs(UBound(inputs)) = possibleInputs(i)
        End If
    Next i

    ZelleWert = CStr(Zelle.Value)

    'loop through given parameters and exit if found
    For Each v In inputs
        SuchenS = InStr(1, ZelleWert, v, vbTextCompare)
        If SuchenS > 0 Then
            Exit Function
        End If
    Next v
End Function

Upvotes: 0

Charles Williams
Charles Williams

Reputation: 23550

You can make some speed gains by converting the cell value to a string once before all the instr calls rather than forcing a variant to string conversion for each call.

Dim ZelleWert as string
ZelleWert=Cstr(Zelle.Value2)

If you have a large number of calls to the UDF you need to avoid the VBE Refresh bug: see https://fastexcel.wordpress.com/2011/06/13/writing-efficient-vba-udfs-part-3-avoiding-the-vbe-refresh-bug/

And you could probably make a faster UDF if you converted the UDF to handle a Range of cells and return an array of results: see https://fastexcel.wordpress.com/2011/06/20/writing-efiicient-vba-udfs-part5-udf-array-formulas-go-faster/

Upvotes: 2

Related Questions