I have two private functions in two different modules. These two functions should share a common variable. How should I go about programming this?
The current code is this:
Private function TestFunction1 (ByVal traffic as string) As Boolean
'snippet from the code
dim amount as string
amount = inputbox("Fill in amount")
end function
Private Function TestFunction2 (ByVal layout as string) as Boolean
'snippet from the code
dim result as string
result = "the amount is: " & amount
end function
I know this is not a correct function but it's just a part of the code. I cannot share the entire code because of business regulations.
How should I go about passing the amount to the other function in another module?
Thanks
Sure, that's doable by declaring the amount variable as Public:
Public amount As Long 'not sure why you declared it as a string, as it seems to be a number
Private function TestFunction1 (ByVal traffic as string) As Boolean
'snippet from the code
amount = inputbox("Fill in amount")
End Function
Related
I have a module that defines a UDT as follows:
Private Type UserData
uName As String 'user name
uDate As Date 'date/time of last interaction
End Type
I have a simple test function that I'm trying to use to compare two different instances of the UDT as follows:
Sub TestCheck()
Dim testRec(1) As UserData
testRec(0).uName = "a"
testRec(0).uDate = Date
testRec(1) = testRec(0)
If testRec(1) = testRec(0) Then
Debug.Print "Records match"
Else
Debug.Print "Records don't match"
End If
End Sub
I get Compile error: Type mismatch on testRec(1) = testRec(0)
I really would rather not have to loop through each member of each instance in order to check for equivalency. Aren't UDTs supposed to act as variables? If I have to loop through each member of each instance to compare them, then it really doesn't save anything for me to use the UDTs. Is there a way to do the comparison without looping through the members?
For anyone who has the same question, based on Brian M Stafford's comments, the simple answer is no.
However, here's a simple function to get the job done:
Private Function UserDataEqual(ByRef varA As UserData, ByRef varB As UserData) As Boolean
If varA.uName = varB.uName _
And varA.uDate = varB.uDate Then
UserDataEqual = True
Else
UserDataEqual = False
End If
End Function
It would be used as follows:
Sub TestCheck()
Dim testRec(1) As UserData
testRec(0).uName = "a"
testRec(0).uDate = Date
testRec(1) = testRec(0)
If UserDataEqual(testRec(1), testRec(0)) Then
Debug.Print "Records match"
Else
Debug.Print "Records don't match"
End If
End Sub
Thanks for answering my questions Brian.
This type of activity is what Classes are for. Instead of a user defined type create a class with appropriate methods. Here we have defined a Class called UserData which has a predeclared Id so that we can use the class as a UserData Factory. In this example we have
UserData Class
' User Rubberduck annotations to set the predecalredId to True
'#PredeclaredId
Option Explicit
Public Enum UserDataType
udDate
udName
End Enum
Private Type Properties
UserData As Object
End Type
Private p As Properties
Public Function Make(ByVal ipName As String, ByVal ipDateAndTime As Date) As UserData
With New UserData
Set Make = .Self(ipName, ipDateAndTime)
End With
End Function
Public Function Self(ByVal ipName As String, ByVal ipDateAndTime As Date) As UserData
' Use late bound crreation of a scripting dictionary to avoid reference issues
Set p.UserData = CreateObject("Scripting.Dictionary")
With p.UserData
.Add udName, ipName
.Add udDate, ipDateAndTime
End With
Set Self = Me
End Function
Public Property Get Item(ByVal ipEnum As Long) As Variant
Item = p.UserData.Item(ipEnum)
End Property
Public Property Let Item(ByVal ipEnum As Long, ByVal ipValue As Variant)
p.UserData.Item(ipEnum) = ipValue
End Property
Public Function SameAs(ByVal ipUserData As UserData) As Boolean
SameAs = False
Dim myIndex As Long
For myIndex = 0 To p.UserData.Count - 1
If Me.Item(myIndex) <> ipUserData.Item(myIndex) Then Exit Function
Next
SameAs = True
End Function
This class makes the creation of user data types a bit easier as we can now just say UserData,Make( ,
So the text sub can become
Option Explicit
Public Sub TestCheck()
Dim testRec(1) As UserData
Set testRec(0) = UserData.Make("a", Date)
Set testRec(1) = UserData.Make("b", Date)
If testRec(1).SameAs(testRec(0)) Then
Debug.Print "Records match"
Else
Debug.Print "Records don't match"
End If
End Sub
As you can see. You can see. To change the UserData class for a different set of members you only have to change the enumeration (provided you keep to simple variables).
Simple answer probably what you were looking for (although won't work in your situation I'm afraid, I'll explain):
'#Description("Returns the count of bytes which match over length")
Public Declare PtrSafe Function RtlCompareMemory Lib "ntdll" ( _
ByRef a As Any, _
ByRef b As Any, _
ByVal Length As LongPtr _
) As LongPtr
Called like:
Debug.Assert RtlCompareMemory(a, b, LenB(a)) = LenB(a) 'checks every byte matches
'Or as a function ?UserDataMatch(a,b)
Public Function UserDataMatch(ByRef a As UserData, ByRef b As UserData) As Boolean
UserDataMatch = RtlCompareMemory(a, b, LenB(a)) = LenB(a)
End Function
The catch is this won't work for you because Strings are stored in the UDT as pointers to some variable length block of memory containing their actual values (and these pointers will never match in VBA). So my approach only works for fixed sized UDTs, e.g.:
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Type UDT
IID As GUID 'nested is fine
ClsID As GUID
RefCount As Long
MyClass As Object 'even classes and objects work - if the UDTs point to the same instance
End Type
But not for a UDT which contains a string or some other immutable reference type where the pointers can never be shared between two variables without low level hackery.
I generally use VBA but have been reading up on programming techniques in The C# Programming Yellow Book which, obviously, is more specific to C#. Anyway, it mentions a technique of passing parameters using the Out keyword.
I already know that VBA supports byVal and byRef and am fairly certain there is no direct equivalent for Out. Passing parameters using Out is subtly different to passing parameters by Ref.
This Answer https://stackoverflow.com/a/388781/3451115 seems to give a good explanation of the difference between Out & Ref.
The Ref modifier means that:
The value is already set and
The method can read and modify it.
The Out modifier means that:
The Value isn't set and can't be read by the method until it is set.
The method must set it before returning.
In the code base that I've inherited there are several places where values are assigned to variables using methods that accept parameters byRef. It seems to me that while passing byRef does the job, passing by Out would be safer... So (and here is the question) is there a way of safely / reliably replicating Out in VBA?
In my first iteration (original question) I imagined that the code would have a pattern like:
Sub byOutExample(byRef foo As String)
' Check before running code:
' foo must = vbNullString
If foo <> vbNullString then Err.Raise(someError)
' Do Something to assign foo
foo = someString
' Check before exiting:
' foo must <> vbNullString
If foo = vbNullString then Err.Raise(someError)
End Sub
Other considerations: is it worth doing, is there a better way, what could go wrong?
Edit: I noticed in the comments for the above definition of Ref vs Out that the passed parameter need not be null, nothing, empty etc. it can be preassigned - the main criteria seems that it is re-assigned.
In light of #ThunderFrame's answer below and the comment that a parameter passed by Out can be pre-assigned (and used), perhaps the following is a better approach:
Sub byOutExample(ByRef foo As String)
Dim barTemp As String
barTemp = foo
' Do Something to assign a new value to foo (via barTemp)
barTemp = someString
' Must assign new variable
foo = barTemp
End Sub
In which case would it be true to say that, as long as foo only appears in the 2 locations shown above, the above code is an accurate way to replicate passing a parameter by Out in VBA?
The answer is unequivocally 'no' you cannot replicate the C# out parameter modifier in VBA. From https://learn.microsoft.com/en-us/dotnet/csharp/language-reference/keywords/out-parameter-modifier:
Variables passed as out arguments do not have to be initialized before
being passed in a method call. However, the called method is required
to assign a value before the method returns.
These aspects simply don't exist in VBA. All variables in VBA are initialised with default values, ie the concept of an unitialised variable does not exist in VBA, so point 1 isn't possible; and the compiler cannot object if a specified parameter has not had a value assigned within the procedure, so point 2 isn't possible either.
Even the coding patterns in your example would rely on the Do Something to assign foo not to resolve to the relevant data type's default value (which is obviously not the same as being unitialised). The following, for example, would wrongly throw an error:
Public Sub Main()
Dim income As Long, costs As Long
Dim result As Long
income = 1000
costs = 500
ProcessSpend income, costs, result
End Sub
Private Sub ProcessSpend(income As Long, costs As Long, ByRef outValue As Long)
Const TAX_RATE As Long = 2
Dim netCosts As Long
Dim vbDefaultValue As Long
netCosts = costs * TAX_RATE
outValue = income - netCosts
If outValue = vbDefaultValue Then Err.Raise 5, , "Unassigned value"
End Sub
So we're really left with the question of is there a way of getting close to the characteristics of out in VBA?
Unitialised variables: the closest I can think of are a Variant or Object type which by default initialise to Empty and Nothing respectively.
Assign value within the procedure: the simplest way would be to test if the address of the assigning procedure matches your desired procedure address.
It's all leaning towards a helper class:
Option Explicit
Private mNumber As Long
Private mTargetProc As LongPtr
Private mAssignedInProc As Boolean
Public Sub SetTargetProc(targetProc As LongPtr)
mTargetProc = targetProc
End Sub
Public Sub SetNumber(currentProc As LongPtr, val As Long)
mAssignedInProc = (currentProc = mTargetProc)
mNumber = val
End Sub
Public Property Get Number() As Long
If mAssignedInProc Then
Number = mNumber
Else
Err.Raise 5, , "Unassigned value"
End If
End Property
And then the previous example would look like this:
Public Sub Main()
Dim income As Long, costs As Long
Dim result As clsOut
income = 1000
costs = 500
ProcessSpend income, costs, result
Debug.Print result.Number
End Sub
Private Sub ProcessSpend(income As Long, costs As Long, outValue As clsOut)
Const TAX_RATE As Long = 2
Dim netCosts As Long
If outValue Is Nothing Then
Set outValue = New clsOut
End If
outValue.SetTargetProc AddressOf ProcessSpend
netCosts = costs * TAX_RATE
outValue.SetNumber AddressOf ProcessSpend, income - netCosts
End Sub
But that's all getting very onerous... and it really feels as if we are trying to force another language's syntax onto VBA. Stepping back a little from the out characteristics and developing in a syntax for which VBA was designed, then a function which returns a Variant seems the most obvious way to go. You could test if you forgot to set the 'out' value by checking if the function returns an Empty variant (which suits point 1 and 2 of the out characteristics):
Public Sub Main()
Dim income As Long, costs As Long
Dim result As Variant
income = 1000
costs = 500
result = ProcessedSpend(income, costs)
If IsEmpty(result) Then Err.Raise 5, , "Unassigned value"
End Sub
Private Function ProcessedSpend(income As Long, costs As Long) As Variant
Const TAX_RATE As Long = 2
Dim netCosts As Long
netCosts = costs * TAX_RATE
'Comment out the line below to throw the unassigned error
ProcessedSpend = income - netCosts
End Function
And if you wanted the option of passing in a pre-assigned value, then could just define an optional argument as a parameter to the function.
You can pseudo enforce an out type parameter in VBA by passing it in ByRef, and then checking that it is Nothing (or the default value for a value type) before continuing, much as you have done with the String in your example.
I wouldn't impose the exit condition - sometimes an empty string is a perfectly valid return value, as is a Nothing reference.
I have the following declared:
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal X0_Y1 As Long) As Long
It grabs the monitor resolution.
So that in the future I remember to type 0 for x resolution and 1 for y resolution I have named the argument variable to illustrate that (X0_Y1). (So user can use ctrl+a or ctrl+Shift+a when entering the function to display its arguments)
But what I really want is to type "x" to get the x res and "y" for y res (i.e. =GetSystemMetrics("x") gives the x resolution). Is there a way to do this within the function decleration? Like (ByVal iif(X0_Y1 ="x",0,1) As Long) to specify what to do with the input.
I'd rather not just do this:
Function GetRes(letter As String) As Long
Dim i As Long
i = IIf(letter = "x", 0, 1)
GetRes = GetSystemMetrics(i)
End Function
As it involves creating a whole new function which is more unweildy than just using the base one.
Perhaps there's some way to specify x/y as constants so that if the user enters them they are read as numbers not strings? Another nice option would be to get the input options displayed like the Cell function does. (Similar to this question, but not the same)
You can use an Enum Statement for this.
Declare an enum and your function like that
Public Enum MetricsType
xMetrics = 0
yMetrics = 1
End Enum
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal xy As MetricsType) As Long
and you can use it like this
Dim x As Long, y As Long
x = GetSystemMetrics(xMetrics)
y = GetSystemMetrics(yMetrics)
This will also enable AutoComplete in the VBA editor.
To enhance the usability within the worksheet you can register/unregister your function as a UDF (user defined function). After registering you can select your function from the function menu and you see the comments within this dialog.
Sub RegisterUDF()
Dim s As String
s = "Some description here" & vbLf _
& "GetSystemMetrics(<Metrics>)"
Application.MacroOptions Macro:="GetSystemMetrics", Description:=s, Category:="My Category"
End Sub
Sub UnregisterUDF()
Application.MacroOptions Macro:="GetSystemMetrics", Description:=Empty, Category:=Empty
End Sub
To get the enum working within the worksheet there is only workaround possible. Therefore you add a named range referring to =0 or =1 like below:
Sub RegisterEnum()
ActiveWorkbook.Names.Add Name:="xMetrics", RefersToR1C1:="=0"
ActiveWorkbook.Names.Add Name:="yMetrics", RefersToR1C1:="=1"
'NOTE: don't use x or y as names here as these refer to the column names.
'That's why I used xMetrics instead.
End Sub
Then you are able to use the function in your worksheet like =GetSystemMetrics(xMetrics).
Creating the exactly same behavior like the built-in functions isn't possible as far as I know.
Private Shared _twolettercountryCodeDict As Generic.Dictionary(Of String, String)
Private Function twolettercountrycode() As String
If _twolettercountryCodeDict Is Nothing Then
_twolettercountryCodeDict = New Generic.Dictionary(Of String, String) From {{"ty", "turkey"}, {"py", "pakinmay"}, {"ra", "romania"}, {"vm", "vietnam"}, {"bl", "brazil"}, {"et", "egypt"}, {"ka", "korea"}}
Dim listOfCountries = fileToCol(COUNTRYCODESFileName)
For Each var In listOfCountries
Dim ar = var.Split({"*"}, System.StringSplitOptions.None).ToList()
_twolettercountryCodeDict.Add(LCase(ar(1)), UCase(ar(0)))
Next
End If
Return _twolettercountryCodeDict(Me.twoletter.ToLower)
End Function
Here, I am using Private Shared _twolettercountryCodeDict As Generic.Dictionary(Of String, String)
That's because I want to share that _twolettercountryCodeDict for the whole program. I am basically implementing lazy loading. I do not want part of the code that read a text file and populate country codes are done again and again.
The thing is if I declare it as Private Shared, other methods on the same class can access that variable too. Which is not much of a problem but say I want to avoid it.
If I declare the variable as static inside the function then the twolettercountryCodeDict won't be shared.
So I am in a dilemma. What's the solution?
Let's just say that twolettercountrycode requires a private member, so it can't be a shared function. But I want _twolettercountryCodeDict to be shared and accessible only from twolettercountrycode. Can I do so?
This doesn't do precisely what you asked for, but it solves the requirement of only allowing the resource loading to be done once. You could achieve the same thing by using a Shared Constructor on a class that's solely for loading your resource.
You may also want to use a ReadOnlyDictionary (implementation) so that your dictionary can't be modified by callers.
Friend Shared ReadOnly Property twolettercountrycode As Generic.Dictionary
Get
Static _twolettercountryCodeDict As Generic.Dictionary = Nothing
If _twolettercountryCodeDict Is Nothing Then
_twolettercountryCodeDict = New Generic.Dictionary(Of String, String) From {{"ty", "turkey"}, {"py", "pakinmay"}, {"ra", "romania"}, {"vm", "vietnam"}, {"bl", "brazil"}, {"et", "egypt"}, {"ka", "korea"}}
Dim listOfCountries = fileToCol(COUNTRYCODESFileName)
For Each var In listOfCountries
Dim ar = var.Split({"*"}, System.StringSplitOptions.None).ToList()
_twolettercountryCodeDict.Add(LCase(ar(1)), UCase(ar(0)))
Next
End If
return _twolettercountryCodeDict
End Get
End Property
Is there any way in which I can generate a unique number in code ?
I had an idea of using system time for that, but eventually could not implement it.
You can use the Now() then format the output to a number:
Sub unique()
Dim t As Date
t = Now()
Range("A1").NumberFormat = "#"
Range("A1") = CStr(Format(t, "yyyymmddhhMMss"))
End Sub
This would be unique.
As #Vasily pointed out, without formatting the cell as string and placing the number as a sting the value gets truncated to scientific notation.
especially for such cases the GUID (Global Unique IDentifyer) was invented. It may be a little bit oversized ... but just that you have seen it:
Option Explicit
Public Type TYP_GUID
bytes(15) As Byte
End Type
Public Declare Function CoCreateGuid Lib "OLE32.dll" _
(guid As TYP_GUID) As Long
Public Function newGUID() As TYP_GUID
Dim uGUID As TYP_GUID
CoCreateGuid uGUID
newGUID = uGUID
End Function
whenever you call newGUID() you will become a value that should be really unique in world. You can try and call it as often as you want ... you will never get the same value a second time.
it's also possible to convert such GUID's to string:
Option Explicit
Public Type TYP_GUID
bytes(15) As Byte
End Type
Public Declare Function CoCreateGuid Lib "OLE32.dll" _
(guid As TYP_GUID) As Long
Public Declare Function StringFromGUID2 Lib "OLE32.dll" _
(guid As TYP_GUID, _
ByVal lpszString As String, _
ByVal iMax As Long) As Long
Public Function newGUID() As TYP_GUID
Dim uGUID As TYP_GUID
CoCreateGuid uGUID
newGUID = uGUID
End Function
Public Function newGUID_String() As String
Dim sBuffer As String
Dim lResult As Long
sBuffer = VBA.Space(78)
lResult = StringFromGUID2(newGUID, sBuffer, Len(sBuffer))
newGUID_String = Left$(StrConv(sBuffer, vbFromUnicode), lResult - 1)
End Function