Excel VBA: If ... then exit UDF without changing cell value

Question

I've had a look around for an answer, but could only find things relating to normal Excel functions. The situation: I have a user defined function (UDF) written up in Excel. I'll provide the code, although I don't think it is particularly important. I would like to prevent the UDF from calculating at certain times (as it is across a few thousand cells, and needs to be turned off when I'm working on other things in the sheet to prevent long waiting times).

Currently I achieve this with cell B1 containing (as the output of a basic formula) "Pause" - and an If statement at the start of my UDF checks for this and exits the function if pause is entered.

Public Function SIMILARITY(ByVal String1 As String, _
    ByVal String2 As String, _
    Optional ByRef RetMatch As String, _
    Optional min_match = 1) As Single
Dim b1() As Byte, b2() As Byte
Dim lngLen1 As Long, lngLen2 As Long
Dim lngResult As Long


If UCase(ActiveSheet.Range("B1").Value) = "PAUSE" Then
    Exit Function

ElseIf UCase(String1) = UCase(String2) Then
    SIMILARITY = 1

Else:
    lngLen1 = Len(String1)
    lngLen2 = Len(String2)
    If (lngLen1 = 0) Or (lngLen2 = 0) Then
        SIMILARITY = 0
    Else:
        b1() = StrConv(UCase(String1), vbFromUnicode)
        b2() = StrConv(UCase(String2), vbFromUnicode)
        lngResult = Similarity_sub(0, lngLen1 - 1, _
        0, lngLen2 - 1, _
        b1, b2, _
        String1, _
        RetMatch, _
        min_match)
        Erase b1
        Erase b2
        If lngLen1 >= lngLen2 Then
            SIMILARITY = lngResult / lngLen1
        Else
            SIMILARITY = lngResult / lngLen2
        End If
    End If
End If

End Function

Private Function Similarity_sub(ByVal start1 As Long, ByVal end1 As Long, _
                                ByVal start2 As Long, ByVal end2 As Long, _
                                ByRef b1() As Byte, ByRef b2() As Byte, _
                                ByVal FirstString As String, _
                                ByRef RetMatch As String, _
                                ByVal min_match As Long, _
                                Optional recur_level As Integer = 0) As Long
'* CALLED BY: Similarity *(RECURSIVE)

Dim lngCurr1 As Long, lngCurr2 As Long
Dim lngMatchAt1 As Long, lngMatchAt2 As Long
Dim I As Long
Dim lngLongestMatch As Long, lngLocalLongestMatch As Long
Dim strRetMatch1 As String, strRetMatch2 As String

If (start1 > end1) Or (start1 < 0) Or (end1 - start1 + 1 < min_match) _
Or (start2 > end2) Or (start2 < 0) Or (end2 - start2 + 1 < min_match) Then
    Exit Function '(exit if start/end is out of string, or length is too short)
End If

For lngCurr1 = start1 To end1
    For lngCurr2 = start2 To end2
        I = 0
        Do Until b1(lngCurr1 + I) <> b2(lngCurr2 + I)
            I = I + 1
            If I > lngLongestMatch Then
                lngMatchAt1 = lngCurr1
                lngMatchAt2 = lngCurr2
                lngLongestMatch = I
            End If
            If (lngCurr1 + I) > end1 Or (lngCurr2 + I) > end2 Then Exit Do
        Loop
    Next lngCurr2
Next lngCurr1

If lngLongestMatch < min_match Then Exit Function

lngLocalLongestMatch = lngLongestMatch
RetMatch = ""

lngLongestMatch = lngLongestMatch _
+ Similarity_sub(start1, lngMatchAt1 - 1, _
start2, lngMatchAt2 - 1, _
b1, b2, _
FirstString, _
strRetMatch1, _
min_match, _
recur_level + 1)
If strRetMatch1 <> "" Then
    RetMatch = RetMatch & strRetMatch1 & "*"
Else
    RetMatch = RetMatch & IIf(recur_level = 0 _
    And lngLocalLongestMatch > 0 _
    And (lngMatchAt1 > 1 Or lngMatchAt2 > 1) _
    , "*", "")
End If


RetMatch = RetMatch & Mid$(FirstString, lngMatchAt1 + 1, lngLocalLongestMatch)


lngLongestMatch = lngLongestMatch _
+ Similarity_sub(lngMatchAt1 + lngLocalLongestMatch, end1, _
lngMatchAt2 + lngLocalLongestMatch, end2, _
b1, b2, _
FirstString, _
strRetMatch2, _
min_match, _
recur_level + 1)

If strRetMatch2 <> "" Then
    RetMatch = RetMatch & "*" & strRetMatch2
Else
    RetMatch = RetMatch & IIf(recur_level = 0 _
    And lngLocalLongestMatch > 0 _
    And ((lngMatchAt1 + lngLocalLongestMatch < end1) _
    Or (lngMatchAt2 + lngLocalLongestMatch < end2)) _
    , "*", "")
End If

Similarity_sub = lngLongestMatch

End Function

Exiting returns a 0 in each cell. However, from earlier running of the code, these cells all already contain values. How can I keep these values the same when I pause, instead of having them switched to zeros? I think an approach could be to temporarily save each cell value at an earlier stage in the UDF, then to call it if B1 does indeed contain 'pause' - but I'm not sure when VBA clears a cell's contents - and I'm also relatively new to VBA so wouldn't know how to anyway!

Thanks

UPDATE: The idea here is to hugely simplify the UDF under the pause circumstance so it takes next to no time to calculate, or to pause the UDF entirely. I would like to preserve all other workbook functionality, so Manual calculation is not an option (+ when I save/open the UDFs are calculated regardless, it would be great to leave the pause in when I save (as in my own attempt at a solution) so that this calculation doesn't take place upon opening/closing/saving the worksheet)

Not a perfect solution, but having DoEvents somewhere in your function will allow you to work on the sheet while the function calculates in the background... — bobajob
– bobajob, Commented Dec 2, 2016 at 10:36
If those "other things" are not affecting your function parameters then adding Application.Volatile = False will have it recalculated only when any of its arguments changes as a result of a recalculation. — user3598756
– user3598756, Commented Dec 2, 2016 at 10:42
@user3598756 The "other things" would be changes made to a source table of data. Within my UDF there is a section which counts elements in the entire table. This would be updated (though not necessarily changed for all cells containing UDFs), but would Application.Volatile prevent recalculation when no change in result will occur? I doubt it, as tracing the precedents on any one of my UDF cells highlights the entire data set. — Greedo
– Greedo, Commented Dec 2, 2016 at 10:56
as I wrote, what matters is "not affecting your function parameters". If that is the case the function will not recalculate. And there's no need for doubts: just try! — user3598756
– user3598756, Commented Dec 2, 2016 at 11:02

user3598756 · Accepted Answer · 2016-12-02 12:28:02Z

1

you could try this:

Function SIMILARITY(ByVal String1 As String, _
                    ByVal String2 As String, _
                    Optional ByRef RetMatch As String, _
                    Optional min_match = 1) As Single

    If UCase(ActiveSheet.Range("B1").Value) = "PAUSE" Then
        SIMILARITY = Application.Caller.Text '<--| "confirm" actual cell value
    Else

        'here goes you "real" function code

    End If

End Function

with the caveat that it has to be enhanced should your function be called form different worksheets

answered Dec 2, 2016 at 12:28

user3598756

29.5k4 gold badges20 silver badges30 bronze badges

Sign up to request clarification or add additional context in comments.

Collectives™ on Stack Overflow

Excel VBA: If ... then exit UDF without changing cell value

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related