First attempt to create the corresponding functionality, would be to create some dummy worksheet UDF, which then calls separate sub routine to write an array of values into Excel worksheet. However, this attempt will fail, because a function called from worksheet is not able to modify any Excel objects (except message box). To get around this limitation (sub routine called inside UDF can not write data back to worksheet) you can use Windows Timer API . First, timer is created at the beginning of a function call. Then, timer is killed as soon as it calls desired sub procedure (which then writes data back to worksheet).
Here's my own BDH mimic below, along with comments. It may not be the most elegant one, but it should show the essence of this approach using Timer API. You can copy-paste the sample code directly into a new VBA standard module and test it. The actual worksheet interface function takes two arguments: value (which is going to be repeated), and repetitions (which defines how many times the value will be repeated below the cell, from which the function call has been made). With this approach, you could create your own UDF which takes any parameters and then retrieves data back to worksheet from database by using ADODB object inside your sub procedure what is going to be called by Timer API.
More information about Windows Timer API can be found here: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632592(v=vs.85).aspx
The code might sometimes look a bit odd within the frame below, but just copy-paste everything within the frame. I have tested the code and it should be working correctly. I hope you could get something out of this. Have a nice day.
-Mike
Option Explicit ' ' Declare needed Windows API Timer dll functions 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 mTimerID As Long Private mValue As Variant Private mItems As Long Private mUpdateMessage As String Private mCurrentCellAddress As String Private mCurrentWorksheetIndex As Integer ' Public Function update(ByVal value As Variant, _ ByVal repetitions As Long) As Variant ' ' this is the worksheet interface function. ' save information from caller, plus information about ' the current worksheet and range mValue = value mItems = repetitions mUpdateMessage = "Updated at " & VBA.CStr(VBA.Now()) mCurrentCellAddress = Application.Caller.Address mCurrentWorksheetIndex = Application.Caller.Parent.Index ' ' set timer to be launched: after 1 millisecond, timer ' will launch sub called fillWorksheet If mTimerID <> 0 Then KillTimer 0&, mTimerID mTimerID = SetTimer(0&, 0&, 1, AddressOf fillWorksheet) ' ' finally, return information about update time for the caller update = mUpdateMessage End Function ' Private Sub fillWorksheet() ' On Error Resume Next KillTimer 0&, mTimerID: mTimerID = 0 ' ' create and modify the range object so, that it does ' not overwrite the actual worksheet function Dim r As Range ' ' UPDATED 31.5.2013 ' before this procedure writes a given value n times into the worksheet, ' the old existing values needs to be cleared from the worksheet first Set r = Sheets(mCurrentWorksheetIndex).Range(mCurrentCellAddress).CurrentRegion Set r = r.Offset(1, 0) r.ClearContents ' ' write given value n (repetitions) times Dim i As Long For i = 1 To mItems r(i, 1) = mValue Next i End Sub '
Awesome post! Thanks for sharing. You saved me.
ReplyDeleteDear Mike,
ReplyDeleteThank you so much for this post! I was struggling to resolve this problem yesterday. Excellent idea to use Timer!
Thnaks Mikael! This works Great! But When i am calling that UDF in multiple cells, it seems to update only one cell among them, not all. Like in Bloomberg BDS function, when we refresh the worksheet, it updates all the cells where the BDS function is called, can we do the similar thing here as well?
ReplyDelete