I am trying to get an effective class constructor that can take parameters. This seems trivial in most programming languages but VBA is very special.
I have the following code in a normal module named Module2:
Public Sub DoTheThing()
Dim this_guy As SetOfGames
Set this_guy = New SetOfGames
Dim that_guy As SetOfGames
Set that_guy = New SetOfGames
MsgBox "First: " & this_guy.games_played & that_guy.games_played
Set this_guy = factory.CreateFromOther(that_guy.games_played, that_guy.extra_games, that_guy.odds, 1)
End Sub
The following in a second normal module named factory:
Public Function CreateFromOther(ByVal other_games_played As Integer, ByVal other_extra_games As Integer, ByVal other_odds As Double, ByVal giraffe_yes As Integer) As SetOfGames
MsgBox "Second: " & other_games_played
Dim setofgames_obj As SetOfGames
Set setofgames_obj = New SetOfGames
MsgBox "Third: " & other_games_played
setofgames_obj.InitiateFromOther ogp = other_games_played, oeg = other_extra_games, g_yes = giraffe_yes
End Function
And the following in a class module named SetOfGames:
Public extra_games As Integer
Public games_played As Integer
Public odds As Double
Function InitiateFromOther(ByVal ogp As Integer, ByVal oeg As Integer, ByVal g_yes As Integer)
MsgBox "Fourth" & ogp
End Function
I call DoTheThing() from an Excel button, which initialized some SetOfGamess and gives the expected number_of_games in the First MSGBOX: 0
CreateFromOther() is called and I get again the right output in MSGBOX second and MSGBOX third: 0
Then I call InitiateFromOther, passing that nice 0 through, but in the first line of the function, I get the MSGBOX Fourth showing it is -1
This is totally misaligned with my intuition and I don't know why I can't keep a variable straight through a function call... I have very little experience with VBA so there is no lower bound on how dumb my problem is. Anyone know what I'm doing wrong?
Related
i want to write something like this:
Public Function functionThatEraseHerself()
functionThatEraseHerself = "here is some work"
'ActiveCell.value = ActiveCell.value
End Function
how it now
how it must to be
It is generally not possible to change cell values from a user defined function called by a formula.
Nevertheless there is a nasty workaround using Evaluate
Option Explicit
'=functionThatEraseHerself()
Public Function functionThatEraseHerself()
Dim ReturnValue As String
ReturnValue = "here is some work"
' write the value to the cell that called this function
Application.Caller.Parent.Evaluate "ReplaceWithValue(" & Application.Caller.Address & ", """ & ReturnValue & """)"
End Function
' helper procedure that is called by evaluate
Public Sub ReplaceWithValue(ByVal Cell As Range, ByVal Value As Variant)
Cell.Value2 = Value
End Sub
I am currently creating a Class Object for a VBA file, its objective is to act as a range dictionary that can be passed single cells. If this cell is contained in one of the ranges, it returns the value associated to the corresponding range key. The class name is "rangeDic".
It is in the making so its functionalities are not implemented yet. Here's the code:
Private zone() As String
Private bounds() As String
Private link As Dictionary
Const ContextId = 33
'Init zone
Private Sub Class_Initialize()
Set link = New Dictionary
ReDim zone(0)
ReDim bounds(0)
End Sub
'properties
Property Get linkDico() As Dictionary
Set linkDico = link
End Property
Property Set linkDico(d As Dictionary)
Set link = d
End Property
Property Get pZone() As String()
pZone = zone
End Property
Property Let pZone(a() As String)
Let zone = a
End Property
'methods
Public Sub findBounds()
Dim elmt As String
Dim i As Integer
Dim temp() As String
i = 1
For Each elmt In zone
ReDim Preserve bounds(i)
temp = Split(elmt, ":")
bounds(i - 1) = temp(0)
bounds(i) = temp(1)
i = i + 2
Next elmt
End Sub
I was trying to instanciate it in a test sub in order to debug mid conception. Here's the code:
Sub test()
Dim rd As rangeDic
Dim ran() As String
Dim tabs() As Variant
Dim i As Integer
i = 1
With ThisWorkbook.Worksheets("DataRanges")
While .Cells(i, 1).Value <> none
ReDim Preserve ran(i - 1)
ReDim Preserve tabs(i - 1)
ran(i - 1) = .Cells(i, 1).Value
tabs(i - 1) = .Cells(i, 3).Value
i = i + 1
Wend
End With
Set rd = createRangeDic(ran, tabs)
End Sub
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
Dim obje As Object
Dim zonesL As Integer
Dim valsL As Integer
Dim i As Integer
zonesL = UBound(zones) - LBound(zones)
valsL = UBound(vals) - LBound(vals)
If zonesL <> valsL Then
Err.Raise vbObjectError + 5, "", "The key and value arrays are not the same length.", "", ContextId
End If
Set obje = New rangeDic
obje.pZone = zones()
For i = 0 To 5
obje.linkDico.add zones(i), vals(i)
Next i
Set createRangeDic = obje
End Function
Take a look at line 2 of Public Function createRangeDic. I have to declare my object as "Object", if I try declaring it as "rangeDic", Excel crashes at line obje.pZone = zones(). Upon looking in the Windows Event Log, I can see a "Error 1000" type of application unknown error resulting in the crash, with "VB7.DLL" being the faulty package.
Why so ? Am I doing something wrong ?
Thanks for your help
Edit: I work under Excel 2016
It looks like this is a bug. My Excel does not crash but I get an "Internal Error".
Let's clarify a few things first, since you're coming from a Java background.
Arrays can only be passed by reference
In VBA an array can only be passed by reference to another method (unless you wrap it in a Variant). So, this declaration:
Property Let pZone(a() As String) 'Implicit declaration
is the equivalent of this:
Property Let pZone(ByRef a() As String) 'Explicit declaration
and of course, this:
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
is the equivalent of this:
Public Function createRangeDic(ByRef zones() As String, ByRef vals() As Variant) As rangeDic
If you try to declare a method parameter like this: ByVal a() As String you will simply get a compile error.
Arrays are copied when assigned
Assuming two arrays called a and b, when doing something like a = b a copy of the b array is assigned to a. Let's test this. In a standard module drop this code:
Option Explicit
Sub ArrCopy()
Dim a() As String
Dim b() As String
ReDim b(0 To 0)
b(0) = 1
a = b
a(0) = 2
Debug.Print "a(0) = " & a(0)
Debug.Print "b(0) = " & b(0)
End Sub
After running ArrCopy my immediate window looks like this:
As shown, the contents of array b are not affected when changing array a.
A property Let always receives it's parameters ByVal regardless of whether you specify ByRef
Let's test this. Create a class called Class1 and add this code:
Option Explicit
Public Property Let SArray(ByRef arr() As String)
arr(0) = 1
End Property
Public Function SArray2(ByRef arr() As String)
arr(0) = 2
End Function
Now create a standard module and add this code:
Option Explicit
Sub Test()
Dim c As New Class1
Dim arr() As String: ReDim arr(0 To 0)
arr(0) = 0
Debug.Print arr(0) & " - value before passing to Let Property"
c.SArray = arr
Debug.Print arr(0) & " - value after passing to Let Property"
arr(0) = 1
Debug.Print arr(0) & " - value before passing to Function"
c.SArray2 arr
Debug.Print arr(0) & " - value after passing to Function"
End Sub
After running Test, my immediate window looks like this:
So, this simple test proves that the Property Let does a copy of the array even though arrays can only be passed ByRef.
The bug
Your original ran variable (Sub test) is passed ByRef to createRangeDic under a new name zones which is then passed ByRef again to pZone (the Let property). Under normal circumstances there should be no issue with passing an array ByRef as many times as you want but here it seems it is an issue because the Property Let is trying to make a copy.
Interestingly if we replace this (inside createRangeDic):
obje.pZone = zones()
with this:
Dim x() As String
x = zones
obje.pZone = x
the code runs with no issue even if obje is declared As rangeDic. This works because the x array is a copy of the zones array.
It looks that the Property Let cannot make a copy of an array that has been passed ByRef multiple times but it works perfectly fine if it was passed ByRef just once. Maybe because of the way stack frames are added in the call stack, there is a memory access issue but difficult to say. Regardless what the problem is, this seems to be a bug.
Unrelated to the question but I must add a few things:
Using ReDim Preserve in a loop is a bad idea because each time a new memory is allocated for a new (larger) array and each element is copied from the old array to the new array. This is very slow. Instead use a Collection as
#DanielDuĊĦek suggested in the comments or minimize the number of ReDim Preserve calls (for example if you know how many values you will have then just dimension the array once at the beginning).
Reading a Range cell by cell is super slow. Read the whole Range into an array by using the Range.Value or Range.Value2 property (I prefer the latter). Both methods returns an array as long as the range has more than 1 cell.
Never expose a private member object of a class if that object is responsible for the internal workings of the class. For example you should never expose the private collection inside a custom collection class because it breaks encapsulation. In your case the linkDico exposes the internal dictionary which can the be modified from outside the main class instance. Maybe it does not break anything in your particular example but just worth mentioning. On the other hand Property Get pZone() As String() is safe as this returns a copy of the internal array.
Add Option Explicit to the top of all your modules/classes to make sure you enforce proper variable declaration. Your code failed to compile for me because none does not exist in VBA unless you have it somewhere else in your project. There were a few other issues that I found once I turned the option on.
I am new to vba and I want to learn. Please help me with the following:
I have this application(see the picture) which I use to enter data in a worksheet (it is more easy to use compared to completing manually). It is basically an inventory management system. When I add a product in there I can choose between sale or purchase.
The next thing I would like to implement is to autofill the form whenever I want to add a sale (considering it was added as a purchase in the first place), based on a serial code for example. This would be very useful because I wont have to complete all the text boxes again when I enter a sale in the database
Do you have any ideas about how I could do this?
Kind regard,
Traian.
So, basically I shouldn't help since you have not done your research, but I did find it interesting to see if I could create such a function.
You wont be able to simply paste the code but it does work exactly as a autofill.
This is the "data" source I used for the autofill, it's looking for the left value and will autocomplete that textbox, as well as a secondary textbox with the value from column C. This would work with n numbers of autofills.
I only used 2 different fields to test this idea, disregard the labels. This is how it looked without typing anything.
As soon as you start to type, the "autofill" appears.
If you were to "hover" over the autofill, it will turn a different color, as well as all the input sheets, the input sheet also now includes the autofilled answers. if you were to "unhover"(hover over anything except the autofill) it will revert back to the second picture.
If I were to write this code again for a real project, I would change a couple of thing.
There might be leftover code from my testing, I would remove this.
I would use global variables so to avoid declaring variables more than one time.
I would name the textboxes and label in a better way.
I would complicate the textboxes with labels as to get the text to align in center.
The order of the code might not be the best for you to understand.
etc.
Here is the code:
Private Sub Autofill_Click()
Dim BestOption As Integer
Dim ValueRange As Range
Set ValueRange = Sheets("sheet1").Range("B8:B13")
Dim Start As Range
Set Start = Sheets("sheet1").Range("B7")
BestOption = WorksheetFunction.Match(Autofill, ValueRange, 0)
TextBox2 = Start.Offset(BestOption, 1)
TextBox1 = Start.Offset(BestOption, 0)
Autofill.Visible = False
TextBox3.Visible = False
TextBox4.Visible = False
End Sub
Private Sub TextBox1_Change()
Dim Start As Range
Dim ValueRange As Range
Dim MatchCounter As Integer
Set Start = Sheets("sheet1").Range("B7")
Set ValueRange = Sheets("sheet1").Range("B8:B13")
If TextBox1 = "" Then
Autofill.Visible = False
Else
'Call FindClosestMatch(TextBox1)
Autofill.Visible = True
Autofill = Start.Offset(FindClosestMatch(TextBox1) + 1, 0)
End If
End Sub
Function FindClosestMatch(Entry As String) As Integer
Dim BestOption As Integer
Dim Start As Range
Set Start = Sheets("sheet1").Range("B7")
Dim MyArray(6) As String
Dim i As Integer
Dim j As Integer
Dim iChar As String
Dim EntryChar As String
For i = 0 To 5
MyArray(i) = Start.Offset(i + 1, 0)
Next i
For j = 1 To Len(Entry)
EntryChar = Mid(Entry, j, 1)
For i = 0 To 5
If EntryChar = "" Then
Exit For
End If
iChar = Mid(MyArray(i), j, 1)
If iChar = EntryChar Then
BestOption = i
Else
MyArray(i) = "................."
End If
Next i
Next j
FindClosestMatch = BestOption
End Function
'hover
Private Sub Autofill_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Autofill.BackColor = &H80000002
TextBox3.BackColor = &H80000002
TextBox4.BackColor = &H80000002
Dim BestOption As Integer
Dim ValueRange As Range
Set ValueRange = Sheets("sheet1").Range("B8:B13")
Dim Start As Range
Set Start = Sheets("sheet1").Range("B7")
BestOption = WorksheetFunction.Match(Autofill, ValueRange, 0)
TextBox3.Visible = True
TextBox4.Visible = True
TextBox4 = Start.Offset(BestOption, 1)
TextBox3 = Start.Offset(BestOption, 0)
End Sub
Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call test
End Sub
Private Sub TextBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call test
End Sub
Private Sub TextBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call test
End Sub
Private Sub TextBox4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call test
End Sub
Private Sub UserForm_Click()
Call test
Autofill.Visible = False
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call test
End Sub
Sub test()
Autofill.BackColor = &H80000000
TextBox1.BackColor = &H80000005
TextBox2.BackColor = &H80000005
TextBox3.Visible = False
TextBox4.Visible = False
End Sub
Problem to think about:
The autofill always give the best answer, even if no good answer exist. In those cases, the best answer is the first answer in the data structure.
It is case sensitive.
One charachter wrong and you wont find your answer.
Notes:
I used 4 textboxes, number 1 and 2 are sitting on top of each other, and number 2 and 4 are on top of each other. This was done to not lose the already typed input if you accidently hovered over the autofill.
I want to use global variables in my workbook and in the ThisWorkbook code. I declared the following varaibles
Public position_1 as string
Public position_2 as string
If I want to see the value of those variables I believe they need to be fully qualified so
Debug.Print ThisWorkbook.position_1
Debug.Print ThisWorkbook.position_2
I have written a UDF which I will pass in an integer to represent which variable I am looking for. I will only be passing in a single number and not a full variable name. I am trying to find a way to use this integer to concatenate with "position_" to display the value of the global variable, ThisWorkbook.position_1, ThisWorkbook.position_2, etc.
Function Test_Global_Var(position as Integer)
Dim variable_name As String
variable_name = "position_" & position
Debug.Print ThisWorkbook.variable_name
End Function
So when I call
Test_Global_Var(1)
my immediate window should display the value of
ThisWorkbook.position_1
The code below produces the following debug output
2 values defined.
ThisWorkbook.Position(0)
First Value
ThisWorkbook.Position(1)
Second Value
It uses a private array in the workbook named m_position. The contents are accessed by a global property ThisWorkbook.Position(index).
In a module have the following code:
Option Explicit
Public Sub Test()
If ThisWorkbook.NoValues Then
ThisWorkbook.FillValues "First Value", "Second Value"
End If
Debug.Print CStr(ThisWorkbook.Count) & " values defined."
Test_Global_Var 0
Test_Global_Var 1
End Sub
Public Sub Test_Global_Var(ByVal index As Long)
' Part of a UDF
Debug.Print "ThisWorkbook.Position(" & CStr(index) & ")"
Debug.Print ThisWorkbook.Position(index)
End Sub
In ThisWorkbook have the following code:
Option Explicit
Private m_position() As Variant
Private Sub Workbook_Open()
Call DefaultValues
End Sub
Public Property Get Position(ByVal index As Long) As Variant
Position = m_position(index)
End Property
Public Sub DefaultValues()
m_position = Array("First", "Second")
End Sub
Public Sub FillValues(ParamArray args() As Variant)
m_position = args
End Sub
Public Property Get Count() As Long
Count = UBound(m_position) - LBound(m_position) + 1
End Property
Public Property Get NoValues() As Boolean
On Error GoTo ArrUndefined:
Dim n As Long
n = UBound(m_position)
NoValues = False
On Error GoTo 0
Exit Sub
ArrUndefined:
NoValues = True
On Error GoTo 0
End Property
PS. In VBA never use Integer, but instead use Long. Integer is a 16bit type, while Long is the standard 32bit type that all other programming languages consider as an integer.
It is possible to consider a global dictionary variable and pass data through it from the UDF.
First add reference to Microsoft Scripting Runtime:
Thus, build the dictionary like this:
Public myDictionary As Dictionary
To initialize the myDictionary variable, consider adding it to a Workbook_Open event:
Private Sub Workbook_Open()
Set myDictionary = New Dictionary
End Sub
Then the UDF would look like this:
Public Function FillDicitonary(myVal As Long) As String
If myDictionary.Exists(myVal) Then
myDictionary(myVal) = "position " & myVal
Else
myDictionary.Add myVal, "position " & myVal
End If
FillDicitonary = "Filled with " & myVal
End Function
And it would overwrite every key in the dictionary, if it exists. At the end, the values could be printed:
Public Sub PrintDictionary()
Dim myKey As Variant
For Each myKey In myDictionary
Debug.Print myDictionary(myKey)
Next
End Sub
Can private sub program being in the same module as main after receiving value from main, creates new variable and pass it back to main?
This is what I am trying to do, but I am having some difficulties.
For example, in testSUB below I altered the string. Can I pass extraSTRING and newSTRING back to main? Any examples would be helpful.
Module module1
Sub main()
Dim l As String
Dim I As Long = 1
Dim A As String
testsub(l, A, I)
End Sub
Private Sub testSub(l As String, A As String, I As Long)
Dim extraSTRING As String = "extraTEXT"
Dim newSTRING As String = l & extraSTRING
End Sub
End Module
To return a value you could turn your Sub into a Function:
Private Function testFunction (ByVal arg1 As String) As String
Return arg1 & " and some more text"
End Function
To call the above Function and assign the value returned use this code:
Dim a As String = testFunction("some text")
'Output:
'a = "some text and some more text"
Below is a screenshot of the code with the output:
Alternatively you can use ByRef:
Specifies that an argument is passed in such a way that the called procedure can change the value of a variable underlying the argument in the calling code.
ByRef differs slightly from ByVal:
Specifies that an argument is passed in such a way that the called procedure or property cannot change the value of a variable underlying the argument in the calling code.
Below is some sample code showing you the differences in action:
Module Module1
Sub Main()
Dim a As Integer = 0
Dim b As Integer = 0
Dim c As Integer = 0
testSub(a, b, c)
'Output:
'a = 0
'b = 0
'c = 3
End Sub
Private Sub testSub(arg1 As Integer, ByVal arg2 As Integer, ByRef arg3 As Integer)
arg1 = 1
arg2 = 2
arg3 = 3
End Sub
End Module
By not specifying a modifier in VB.NET (as shown with arg1 above) the compiler by default will use ByVal.
It would be good to note here that although VB.NET uses ByVal by default if not specified, VBA does not and instead by default uses ByRef. Beware of this should you ever port code from one to the other.
Below is a screenshot of the code with the output:
Using your code as an example:
Sub main()
Dim l As String
Dim A As String
Dim I As Long = 1
testSub(l, A, I)
End Sub
To pass the variables l, A and I and have their value changed you would change your method to use the modifier ByRef.
Private Sub testSub(ByRef l As String, ByRef A As String, ByRef I As Long)
l = "TEXT"
A = "extra" & l
I = 100
End Sub
Below is a screenshot of the code with the output: