I Don't Want My Excel Add-In to Return an Array (Instead I Need a Udf to Change Other Cells)

I don't want my Excel Add-In to return an array (instead I need a UDF to change other cells)

It is actually possible albeit complex. I am reposting this piece of magic from Kevin Jones aka Zorvek as it sits behind the EE Paywall (link attached if anyone has access)

While Excel strictly forbids a UDF from changing any cell, worksheet,
or workbook properties, there is a way to effect such changes when a
UDF is called using a Windows timer and an Application.OnTime timer in
sequence. The Windows timer has to be used within the UDF because
Excel ignores any Application.OnTime calls inside a UDF. But, because
the Windows timer has limitations (Excel will instantly quit if a
Windows timer tries to run VBA code if a cell is being edited or a
dialog is open), it is used only to schedule an Application.OnTime
timer, a safe timer which Excel only allows to be fired if a cell is
not being edited and no dialogs are open.

The example code below illustrates how to start a Windows timer from
inside a UDF, how to use that timer routine to start an
Application.OnTime timer, and how to pass information known only to
the UDF to subsequent timer-executed routines. The code below must be
placed in a regular module.

Private Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long _
) As Long

Private Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long _
) As Long

Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date

Public Function AddTwoNumbers( _
ByVal Value1 As Double, _
ByVal Value2 As Double _
) As Double

' This is a UDF that returns the sum of two numbers and starts a windows timer
' that starts a second Appliction.OnTime timer that performs activities not
' allowed in a UDF. Do not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile formulas/functions or
' uncontrolled looping will start.

AddTwoNumbers = Value1 + Value2

' Cache the caller's reference so it can be dealt with in a non-UDF routine
If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
On Error Resume Next
mCalculatedCells.Add Application.Caller, Application.Caller.Address
On Error GoTo 0

' Setting/resetting the timer should be the last action taken in the UDF
If mWindowsTimerID <> 0 Then KillTimer 0&, mWindowsTimerID
mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)

End Function

Public Sub AfterUDFRoutine1()

' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.

' Stop the Windows timer
On Error Resume Next
KillTimer 0&, mWindowsTimerID
On Error GoTo 0
mWindowsTimerID = 0

' Cancel any previous OnTime timers
If mApplicationTimerTime <> 0 Then
On Error Resume Next
Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
On Error GoTo 0
End If

' Schedule timer
mApplicationTimerTime = Now
Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"

End Sub

Public Sub AfterUDFRoutine2()

' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).

Dim Cell As Range

' Do tasks not allowed in a UDF...
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do While mCalculatedCells.Count > 0
Set Cell = mCalculatedCells(1)
mCalculatedCells.Remove 1
Cell.Offset(0, 1).Value = Cell.Value
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Prevent recalculations of User Defined Functions used in named ranges

Aside from trying to fix the basic problem of how many times your functions get called, you can partially address the slow-down by optimizing the basic performance:

  • Application.Match is relatively slow unless the data being searched in on a worksheet
  • Reading a range into an array is slower than reading the whole range at once using its .Value (assuming range is a single area)

So:

Sub PerfTester()
Const ARR_SZ As Long = 10

Dim arr(1 To ARR_SZ), i, n, t, v, m

'populate a test array
For i = 1 To ARR_SZ
arr(i) = i
Next i

t = Timer
For n = 1 To 100000
v = Round(Rnd * ARR_SZ, 0)
m = IsInArray(v, arr) 'using match
Next n
Debug.Print Timer - t '~ 1.7 sec

t = Timer
For n = 1 To 100000
v = Round(Rnd * ARR_SZ, 0)
m = IsInArray2(v, arr) 'using a loop
Next n
Debug.Print Timer - t '~0.11 sec

t = Timer
For n = 1 To 100000
v = data_to_array(Range("A1:A50")) 'using cell-by-cell
Next n
Debug.Print Timer - t '~ 11.5 sec

t = Timer
For n = 1 To 100000
v = data_to_array2(Range("A1:A50")) 'using single read from range
Next n
Debug.Print Timer - t '~ 2.8 sec


End Sub


Private Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function

Private Function IsInArray2(stringToBeFound As Variant, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
If arr(i) = stringToBeFound Then
IsInArray2 = True
Exit For
End If
Next i
End Function

Private Function data_to_array(data As Range)
Dim arrArray As Variant, cell As Range, z As Integer
z = 0
ReDim arrArray(1 To data.Cells.Count)
For Each cell In data
z = z + 1
arrArray(z) = cell.Value
Next cell
data_to_array = arrArray
End Function

Private Function data_to_array2(data As Range)
Dim arrArray As Variant, cell As Range, z As Long, v
v = data.Value
ReDim arrArray(1 To UBound(v, 1))
For z = 1 To UBound(v, 1)
arrArray = v(z, 1)
Next z
data_to_array2 = arrArray
End Function

Using a UDF in Excel to update the worksheet

Posting a response so I can mark my own "question" as having an answer.

I've seen other workarounds, but this seems simpler and I'm surprised it works at all.

Sub ChangeIt(c1 As Range, c2 As Range)
c1.Value = c2.Value
c1.Interior.Color = IIf(c1.Value > 10, vbRed, vbYellow)
End Sub


'######## run as a UDF, this actually changes the sheet ##############
' changing value in c2 updates c1...
Function SetIt(src, dest)

dest.Parent.Evaluate "Changeit(" & dest.Address(False, False) & "," _
& src.Address(False, False) & ")"

SetIt = "Changed sheet!" 'or whatever return value is useful...

End Function

Please post additional answers if you have interesting applications for this which you'd like to share.

Note: Untested in any kind of real "production" application.

Execute a user-defined function into another cell VBA Excel

So far the comments are correct in that they repeat the simple point that a User-Defined Function called a worksheet can only return a value, and all other actions that might inject values elsewhere into the worksheet calculation tree are forbidden.

That's not the end of the story. You'll notice that there are add-ins, like the Reuters Eikon market data service and Bloomberg for Excel, that provide functions which exist in a single cell but which write blocks of data onto the sheet outside the calling cell.

These functions use the RTD (Real Time Data) API. However, RTD is all about COM servers outside Excel.exe, you have to write them in another language (usually C# or C++), and that isn't the question you asked: you want to do this in VBA.

But I have, at least, made a token effort to give the 'right' answer.

Now for the 'wrong' answer, and actually doing something Microsoft would rather you didn't do. You can't just call a function, call a subroutine or method from the function, and write to the secondary target using the subroutine: Excel will follow the chain and detect that you're injecting values into the sheet calculation, and the write will fail.

You have to insert a break into that chain; and this means using events, or a timer call, or (as in RTD) an external process.

I can suggest two methods that will actually work:

1: Monitor the cell in the Worksheet_Change event:

 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim strFunc As String

strFunc = "NukeThePrimaryTargets"

If Left(Target.Formula, Len(strFunc) + 1) = strFunc Then
    Call NukeTheSecondaryTargets
End If

End Sub

Alternatively...

2: Use the Timer callback API:

However, I'm not posting code for that: it's complex, clunky, and it takes a lot of testing (so I'd end up posting untested code on StackOverflow). But it does actually work.

UDF function to name a range

With the help of the Marks answer I found the following solution for my problem, see the solution below. It is a bit long and not straight forward but it works. Calling

giveNameToRange("Tank101")

within the cell gives the name "Tank 101" to this cell. The code is:

Private Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long _
) As Long

Private Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long _
) As Long

Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date

Public Function giveNameToRange(newName) As String

' This is a UDF that returns the sum of two numbers and starts a windows timer
' that starts a second Appliction.OnTime timer that performs activities not
' allowed in a UDF. Do not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile formulas/functions or
' uncontrolled looping will start.

newName = Replace(newName, " ", "")
giveNameToRange = newName

' Cache the caller's reference so it can be dealt with in a non-UDF routine
If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
On Error Resume Next
mCalculatedCells.Add Application.Caller, Application.Caller.Address
On Error GoTo 0

' Setting/resetting the timer should be the last action taken in the UDF
If mWindowsTimerID <> 0 Then KillTimer 0&, mWindowsTimerID
mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)

End Function

Public Sub AfterUDFRoutine1()

' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.

' Stop the Windows timer
On Error Resume Next
KillTimer 0&, mWindowsTimerID
On Error GoTo 0
mWindowsTimerID = 0

' Cancel any previous OnTime timers
If mApplicationTimerTime <> 0 Then
On Error Resume Next
Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
On Error GoTo 0
End If

' Schedule timer
mApplicationTimerTime = Now
Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"

End Sub

Public Sub AfterUDFRoutine2()

' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).

Dim Cell As Range

' Do tasks not allowed in a UDF...
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do While mCalculatedCells.Count > 0
Set Cell = mCalculatedCells(1)
mCalculatedCells.Remove 1
Cell.name = Cell.Value
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Related Topics



Leave a reply



Submit