EXCEL VBA: calling an event with onclick property of a button which is being created on the fly - excel

I am creating a excel VBA userform which requires many buttons to be created on the fly (ie as the requirement may be, runtime). I want to assign a subroutine to these buttons so that when they are clicked a subroutine should execute.
this is what I want to do
Set obj4 = usrform.Controls.Add("forms.commandbutton.1")
obj4.Height = 17
obj4.Left = 450
obj4.Top = 75
obj4.Font.Size = 11
obj4.Name = "compare" & (j - i) 'j and i are some variables in the code
obj4.Caption = "Compare!"
obj4.onclick = abcd
public sub abcd()
'some code here
end sub
but this code is not running. I read somewhere that here I cannot call a subroutine but a function. My problem is that I want a subroutine only as I dont intend to get something in return from it. But still for trial purpose I made abcd() a function in the above code and then my code was running but unsuccessfully as it was executing the function abcd without the need of button getting pressed.
Can anyone help me with this? I have searched a lot for this on internet in various forums.

Don't get hung up on subroutine v. function: if you don't set the return value of a function, it's the same as a subroutine.
When you set the onClick property, you give it the name of the function as a string obj4.onclick = "abcd" otherwise it will execute the function and save the return value.

Related

EXCEL VBA Type mismatch with "Next" highlighted

I'm creating small project in Excel, and because I'm a VBA newbie I do encounter a lot of problems that I'm trying to resolve on my own. However i can't cope with this:
I created Sub that accepts two objects: FormName and ControlName.
What i want it to do, is to loop through every Control in specific UserForm and populate every ListBox it encounters, from another ListBox.
I created this funny string comparison, because I need to operate on objects in order to execute the line with AddItem. This comparison actually works well, no matter how ridiculous it is. However when I launch the program, I got
Type Mismatch error
and to my surprise "Next" is being highlighted. I have no idea how to fix this, nor what is wrong.
Public Sub deploy(ByRef FormName As Object, ByRef ControlName As Object)
Dim i As Integer
Dim O As msforms.ListBox
i = 0
For Each O In FormName.Controls
If Left(FormName.Name & O.Name, 16) = Left(FormName.Name & ControlName.Name, 16) Then
O.AddItem (FormName.PodglÄ…d.List(i))
i = i + 1
End If
Next
End Sub
I call this sub using:
Call deploy(UserForm1, UserForm1.ListBox3)
Above, I use Listbox3 because otherwise i got error saying that variable is not defined. However in my comparison I kinda override this.
If someone can explain in simple words, how to fix this type mismatch issue or how to write it in more elegant way

Calling a VBA form from a button causes UserForm_Initialize to run twice, breaking my code?

Hello wonderful VBA community,
I'm still really new to vba and am trying to learn a lot. Thank you in advance for looking through my code and my description of the issue I'm facing.
I have a button on a page that calls a new Userform.
CODE SNIPPET 1:
Sub btnShowDetails_Click()
Call frmShowDeets.ShowDeets
End Sub
... which calls the next bit of code in the 'frmShowDeets' UserForm:
CODE SNIPPET 2:
Public Sub ShowDeets()
Dim frm As frmShowDeets
Set frm = New frmShowDeets 'this line triggers the Userform_Initialize() event below
frm.Show
End Sub
... triggering:
CODE SNIPPET 3:
Private Sub UserForm_Initialize()
Dim comboBoxItem As Range
For Each comboBoxItem In ContactList.Range("tblContactList[CompanyName]")
'^refers to unique values in a named range
With Me.boxCompanySelection
.AddItem comboBoxItem.Value
End With
Next comboBoxItem
End Sub
So at this point, the form I want to display has values loaded in its one combobox for user selection. The user selects a company and the Combobox_Change event triggers other routines that pull information for that company.
CODE SNIPPET 4:
Public Sub boxCompanySelection_Change()
Call frmShowDeets.PullData
End Sub
Sub PullData()
Dim numCompanies As Long
numCompanies = ContactList.Range("B6").Value 'this holds a count of the rows in the named range
Dim FoundCell As Range
Set FoundCell = ContactList.Range("tblContactList[Company Name]").Find(What:=boxCompanySelection.Text, LookIn:=xlValues, LookAt:=xlWhole)
Dim CompanyRow As Long
CompanyRow = FoundCell.Row
With ContactList
'pull a bunch of the company's details
End With
End Sub
Here is where it gets weird... Once the form is shown and the user selects one of the combo box items, triggering the Combobox_Change event the code breaks because the 'What:=boxCompanySelection.Text' part of the Range().Find method reads as "" empty (even though Code Snippet 3 is meant to load in company names and Code Snippet 4 is only triggered when the user selects one of those company names from the combobox) and I shouldn't need to build something to handle 'not found' exceptions since the only possible values should be the ones pulled in from my named range.
From stepping through the code, I have determined that for some reason, Code Snippets 2 and 3 run TWICE before Snippet 4 is run. Does anyone know what about my code is causing this to happen? I'm thinking there's a disconnect between the form that is shown and loaded with combobox values and whatever Code Snippet 4 is reading data from.
What is weirder is that if I run the code starting from Code Snippet 2 (ignoring the button call in Code Snippet 1), the form works as intended and from what I can tell 2 and 3 are only run once.
The problem is probably something simple I'm overlooking but I just cannot figure out what it is. Thanks again!
You have to understand that a form is an object - exactly as any other class module, except a form happens to have a designer and a base class, so UserForm1 inherits the members of the UserForm class.
A form also has a default instance, and a lot of tutorials just happily skip over that very important but rather technical bit, which takes us exactly here on Stack Overflow, with a bug involving global state accidentally stored on the default instance.
Call frmShowDeets.ShowDeets
Assuming frmShowDeets is the name of the form class, and assuming this is the first reference to that form that gets to run, then the UserForm_Initialize handler of the default instance runs when the . dot operator executes and dereferences the object. Then the ShowDeets method runs.
Public Sub ShowDeets()
Dim frm As frmShowDeets
Set frm = New frmShowDeets 'this line triggers the Userform_Initialize() event below
frm.Show
End Sub
That line triggers UserForm_Initialize on the local instance named frm - which is an entirely separate object, of the same class. The Initialize handler runs whenever an instance of a class is, well, initialized, i.e. created. The Terminate handler runs when that instance is destroyed.
So ShowDeets is acting as some kind of "factory method" that creates & shows a new instance of the frmShowDeets class/form - in other words whatever happened on the default instance is irrelevant beyond that point: the object you're working with exists in the ShowDeets scope, is named frm, and gets destroyed as soon as it goes out of scope.
Remove the ShowDeets method altogether. Replace this:
Call frmShowDeets.ShowDeets
With this:
With New frmShowDeets
.Show
End With
Now the Initialize handler no longer runs on the default instance.
What you want, is to avoid using the default instance at all. Replace all frmShowDeets in the form's code-behind, with Me (see Understanding 'Me' (no flowers, no bees)), so that no state ever accidentally gets stored in the default instance.
Call frmShowDeets.PullData
Becomes simply:
Call Me.PullData
Or even:
PullData
Since Call is never required anywhere, and the Me qualifier is always implicit when you make a member call in a class module's code.

Declaring a UserForm listbox as a variable in a module? Excel VBA

Alright this is my first post on here so be gentle.
I have a Userform with a listbox containing x amount of values. I have a separate module that calls this Userform and then performs some procedures based on the values chosen in the listbox. I have the following:
Dim lb as ListBox
lb = Userform1.Listbox1
For x = 0 to lb.ListCount - 1 Then
'Do the stuff I need it to
Next x
The problem I am getting is that lb returns a "Nothing".
I am sure this is something simple but I can't figure it out. Appreciate the help.
Are you closing your userform before you are running your code, as if this the case then your listbox is effectively non existent in memory and you listcount will not return anything. You can also remove the line where you are assigning your lb variable and directly get the listcount of the listbox like the code below. Also if you dont want the userform to show when you code is doing the loop just hide the userform run the loop and then unload the userform after that. This way you list box is still in memory long enough for the loop to get the correct value
for x = 1 to userform.listbox.listcount
'' Do you stuff
next x
I tried the code and it gave me the correct value. If there is anything else let me know and hope this helps :)
Declare the module just like that.
Sub listboxpopulate(listb as string,usf as userform)
for i=0 Usf.controls(listb).listcount-1
Do ur stuff
Next
End sub
This will help

Using an if statement within a for loop- Excel VBA

I'm having trouble using an if statement inside a for loop in excel vba. The output of the debugger is not what I expect. I can post the full code of what I am trying to accomplish, but I think I have narrowed it down to what I don't understand. Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 9 To 60 Step 3
If Cells(i, "DR").Value < Cells(i, "EB").Value Then
Debug.Print i & "-ifloopstart"
Cells(i, "DR").Value = 999999
Debug.Print i & "-ifloopend"
End If
Next i
End Sub
The output of the debugger is:
9-ifloopstart
33-ifloopstart
51-ifloopstart
51-ifloopend
33-ifloopend
9-ifloopend
However, I expected:
9-ifloopstart
9-ifloopend
33-ifloopstart
33-ifloopend
51-ifloopstart
51-ifloopend
Can someone explain how this works? It seems to be looping back to the beginning of the if statement instead of finishing the if statement. How can I modify the code to get the output I expect? I've been struggling with this for hours and it seems so simple :( .
Each time the worksheet is updated with Cells(i, "DR").Value = 999999, Worksheet_Change gets called again.
Think of it this way. Each time that above code gets called, you modify a cell, which triggers the worksheet change method again.
So you are effectively nesting three calls of this function:
called once, with i = 9
called again, with i = 33
called again, with i = 51
finishes i = 51 call
finishes i = 33 call
finishes i = 9 call
VBA then goes backwards from each of these to get back to the first time your method was run.
Edit: as Tim says you can disable this with Application.EnableEvents=False

Excel UDF calculation should return 'original' value

I have created a VSTO plugin with my own RTD implementation that I am calling from my Excel sheets. To avoid having to use the full-fledged RTD syntax in the cells, I have created a UDF that hides that API from the sheet.
The RTD server I created can be enabled and disabled through a button in a custom Ribbon component.
The behavior I want to achieve is as follows:
If the server is disabled and a reference to my function is entered in a cell, I want the cell to display Disabled.
If the server is disabled, but the function had been entered in a cell when it was enabled (and the cell thus displays a value), I want the cell to keep displaying that value.
If the server is enabled, I want the cell to display Loading.
Sounds easy enough. Here is an example of the - non functional - code:
Public Function RetrieveData(id as Long)
Dim result as String
// This returns either 'Disabled' or 'Loading'
result = Application.Worksheet.Function.RTD("SERVERNAME", "", id)
RetrieveData = result
If(result = "Disabled") Then
// Obviously, this recurses (and fails), so that's not an option
If(Not IsEmpty(Application.Caller.Value2)) Then
// So does this
RetrieveData = Application.Caller.Value2
End If
End If
End Function
The function will be called in thousands of cells, so storing the 'original' values in another data structure would be a major overhead and I would like to avoid it. Also, the RTD server does not know the values, since it also does not keep a history of it, more or less for the same reason.
I was thinking that there might be some way to exit the function which would force it to not change the displayed value, but so far I have been unable to find anything like that.
EDIT:
Due to popular demand, some additional info on why I want to do all this:
As I said, the function will be called in thousands of cells and the RTD server needs to retrieve quite a bit of information. This can be quite hard on both network and CPU. To allow the user to decide for himself whether he wants this load on his machine, they can disable the updates from the server. In that case, they should still be able to calculate the sheets with the values currently in the fields, yet no updates are pushed into them. Once new data is required, the server can be enabled and the fields will be updated.
Again, since we are talking about quite a bit of data here, I would rather not store it somewhere in the sheet. Plus, the data should be usable even if the workbook is closed and loaded again.
Different tack=new answer.
A few things I've discovered the hard way, that you might find useful:
1.
In a UDF, returning the RTD call like this
' excel equivalent: =RTD("GeodesiX.RTD",,"status","Tokyo")
result = excel.WorksheetFunction.rtd( _
"GeodesiX.RTD", _
Nothing, _
"geocode", _
request, _
location)
behaves as if you'd inserted the commented function in the cell, and NOT the value returned by the RTD. In other words, "result" is an object of type "RTD-function-call" and not the RTD's answer. Conversely, doing this:
' excel equivalent: =RTD("GeodesiX.RTD",,"status","Tokyo")
result = excel.WorksheetFunction.rtd( _
"GeodesiX.RTD", _
Nothing, _
"geocode", _
request, _
location).ToDouble ' or ToString or whetever
returns the actual value, equivalent to typing "3.1418" in the cell. This is an important difference; in the first case the cell continues to participate in RTD feeding, in the second case it just gets a constant value. This might be a solution for you.
2.
MS VSTO makes it look as though writing an Office Addin is a piece of cake... until you actually try to build an industrial, distributable solution. Getting all the privileges and authorities right for a Setup is a nightmare, and it gets exponentially worse if you have the bright idea of supporting more than one version of Excel. I've been using Addin Express for some years. It hides all this MS nastiness and let's me focus on coding my addin. Their support is first-rate too, worth a look. (No, I am not affiliated or anything like that).
3.
Be aware that Excel can and will call Connect / RefreshData / RTD at any time, even when you're in the middle of something - there's some subtle multi-tasking going on behind the scenes. You'll need to decorate your code with the appropriate Synclock blocks to protect your data structures.
4.
When you receive data (presumably asynchronously on a separate thread) you absolutely MUST callback Excel on the thread on which you were intially called (by Excel). If you don't, it'll work fine for a while and then you'll start getting mysterious, unsolvable crashes and worse, orphan Excels in the background. Here's an example of the relevant code to do this:
Imports System.Threading
...
Private _Context As SynchronizationContext = Nothing
...
Sub New
_Context = SynchronizationContext.Current
If _Context Is Nothing Then
_Context = New SynchronizationContext ' try valiantly to continue
End If
...
Private Delegate Sub CallBackDelegate(ByVal GeodesicCompleted)
Private Sub GeodesicComplete(ByVal query As Query) _
Handles geodesic.Completed ' Called by asynchronous thread
Dim cbd As New CallBackDelegate(AddressOf GeodesicCompleted)
_Context.Post(Function() cbd.DynamicInvoke(query), Nothing)
End Sub
Private Sub GeodesicCompleted(ByVal query As Query)
SyncLock query
If query.Status = "OK" Then
Select Case query.Type
Case Geodesics.Query.QueryType.Directions
GeodesicCompletedTravel(query)
Case Geodesics.Query.QueryType.Geocode
GeodesicCompletedGeocode(query)
End Select
End If
' If it's not resolved, it stays "queued",
' so as never to enter the queue again in this session
query.Queued = Not query.Resolved
End SyncLock
For Each topic As AddinExpress.RTD.ADXRTDTopic In query.Topics
AddinExpress.RTD.ADXRTDServerModule.CurrentInstance.UpdateTopic(topic)
Next
End Sub
5.
I've done something apparently akin to what you're asking in this addin. There, I asynchronously fetch geocode data from Google and serve it up with an RTD shadowed by a UDF. As the call to GoogleMaps is very expensive, I tried 101 ways and several month's of evenings to keep the value in the cell, like what you're attempting, without success. I haven't timed anything, but my gut feeling is that a call to Excel like "Application.Caller.Value" is an order of magnitude slower than a dictionary lookup.
In the end I created a cache component which saves and re-loads values already obtained from a very-hidden spreadsheet which I create on the fly in Workbook OnSave. The data is stored in a Dictionary(of string, myQuery), where each myQuery holds all the relevant info.
It works well, fulfils the requirement for working offline and even for 20'000+ formulas it appears instantaneous.
HTH.
Edit: Out of curiosity, I tested my hunch that calling Excel is much more expensive than doing a dictionary lookup. It turns out that not only was the hunch correct, but frighteningly so.
Public Sub TimeTest()
Dim sw As New Stopwatch
Dim row As Integer
Dim val As Object
Dim sheet As Microsoft.Office.Interop.Excel.Worksheet
Dim dict As New Dictionary(Of Integer, Integer)
Const iterations As Integer = 100000
Const elements As Integer = 10000
For i = 1 To elements + 1
dict.Add(i, i)
Next
sheet = _ExcelWorkbook.ActiveSheet
sw.Reset()
sw.Start()
For i As Integer = 1 To iterations
row = 1 + Rnd() * elements
Next
sw.Stop()
Debug.WriteLine("Empty loop " & (sw.ElapsedMilliseconds * 1000) / iterations & " uS")
sw.Reset()
sw.Start()
For i As Integer = 1 To iterations
row = 1 + Rnd() * elements
val = sheet.Cells(row, 1).value
Next
sw.Stop()
Debug.WriteLine("Get cell value " & (sw.ElapsedMilliseconds * 1000) / iterations & " uS")
sw.Reset()
sw.Start()
For i As Integer = 1 To iterations
row = 1 + Rnd() * elements
val = dict(row)
Next
sw.Stop()
Debug.WriteLine("Get dict value " & (sw.ElapsedMilliseconds * 1000) / iterations & " uS")
End Sub
Results:
Empty loop 0.07 uS
Get cell value 899.77 uS
Get dict value 0.15 uS
Looking up a value in a 10'000 element Dictionary(Of Integer, Integer) is over 11'000 times faster than fetching a cell value from Excel.
Q.E.D.
Maybe... Try making your UDF wrapper function non-volatile, that way it won't get called unless one of its arguments changes.
This might be a problem when you enable the server, you'll have to trick Excel into calling your UDF again, it depends on what you're trying to do.
Perhaps explain the complete function you're trying to implement?
You could try Application.Caller.Text This has the drawback of returning the formatted value from the rendering layer as text, but seems to avoid the circular reference problem.Note: I have not tested this hack under all possible circumstances ...

Resources