Excel VBA: Adding objects to a collection within a class - excel

I am trying to create a class (named ClassSection) that contains a collection (named DefectCollection). It needs a function to add items to that collection but I'm having trouble making it work. I get Error 91 "Object variable or with block variable not set."
I have looked at the other answers on here, which is what got me this far, but I don't understand what I'm missing.
Here is the class module code:
Public DefectCollection As Collection
Private Sub Class_Initialise()
Set DefectCollection = New Collection
End Sub
Public Function AddDefect(ByRef defect As CDefect)
DefectCollection.Add defect [<---- error 91]
End Function
And here is the code that calls the function: ('defect' is another class, which works fine - I want each 'ClassSection' to be able to hold an unlimited number of 'defects')
Dim SC As Collection
Dim section As ClassSection
Set SC = New Collection
Dim SurveyLength As Double
For Each defect In DC
SurveyLength = WorksheetFunction.Max(SurveyLength, defect.Pos, defect.EndPos)
Next defect
SurveyLength = Int(SurveyLength)
For i = 0 To numSurveys
For j = 0 To SurveyLength
Set section = New ClassSection
section.ID = CStr(j & "-" & dates(i))
SC.Add Item:=section, Key:=section.ID
Next j
Next i
Dim meterage As Double
For Each defect In DC
meterage = Int(defect.Pos)
Set section = SC.Item(meterage & "-" & defect.SurveyDate)
section.AddDefect defect
Next defect
Thanks!

You get the error because the DefectCollection is Nothing. This is due to the fact that you mispelled the initalization method:
Private Sub Class_Initialise() '<-- it's with "Z", not "S"
Hence, the initialization of the class is never called, the object remain Nothing by default and the method fails when trying to add an object to Nothing

Related

Excel freeze after stopping working macros

Let me explain.
I have a state similarity implementation in excel. One module, called a state, contains many public dictionaries at the top level.
I fill each dictionary with a huge number of object classes - mostly just data from sheets. Simple practice. The problem starts after the macro has worked normally, it leaves all these dictionaries in memory, in the task manager the Excel occupies from 2GB - this is also normal.
State Module - Standalone module
public Dict1 as Dictionary
public Dict2 as Dictionary
'Persists sheets data
public Dict3 as Dictionary
public Dict4 as Dictionary
'For persists renaming some objs
public Dict5 as Dictionary
public Dict6 as Dictionary
public Dict7 as Dictionary
Class Module - Data Interface Example - clsData
Public Name as string
Public Prop1 as string
Public Prop2 as Integer
Public Prop3 as Date
Public Prop4 as string
Public Value as double
The code below is just an example for stackoverflow. In my modules I am grabbing data from a sheet with the Range.CurrentRegion and iterate lbound to ubound.
Another data grabber
Function DataGrabberFromSheet(ByRef CurrentDict as Dict) as String
Dim i as long
Dim data as variant
Dim DataObj as clsData
set CurrentDict = New Dictionary <--- That's recreate dict obj and start clear old data for some how, but i do not need that anymore.
data = Sheet1.Range("A1:Q5000").Values
for i = 1 to 5000
set DataObj = new clsData
DataObj.Name = data(i, 1)
DataObj.Prop1 = data(i,2)
...
call CurrentDict.add(DataObj.Name, DataObj)
next
'For logging, it just an example:
If Success then
DataGrabberFromSheet = "Success"
else
DataGrabberFromSheet = "Bad"
endif
end Function
And so I decide in the debbuger to forcibly stop the program by pressing the stop button. At this point, Excel freezes for a long time, because I already have 50 or more of these dictionaries in the RAM, some of them have 200k elements each. Sometimes it takes about 300 seconds, and sometimes it instantly clears it somehow.
Old data erase by item, I think, but I do not need that data anymore. Can excel just skip that part of memory and just rewrite a new data.
How can I instantly redefine these dictionaries when the macro is rerun and not have to wait for that long cleanup? data is no longer needed at this point
Classic internet methods optimisations not solved that problem:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
...
I think this is a known issue with VBA - clearing a large number of objects takes a long time: regardless of whether they're stored in a dictionary, collection, or an array.
For example:
Dim arr() As clsData
Sub Tester()
Const NUM As Long = 120000
Dim i As Long, obj As clsData, t
t = Timer
Debug.Print "---------"
ReDim arr(1 To NUM)
Debug.Print "Reset", Timer - t
t = Timer
For i = 1 To NUM
Set obj = New clsData
obj.Prop1 = "Item" & i
obj.Prop2 = "Item" & i
obj.Prop3 = "Item" & i
obj.Prop4 = "Item" & i
Set arr(i) = obj
Next i
Debug.Print "Fill", Timer - t
End Sub
Where clsData is just:
Public Prop1
Public Prop2
Public Prop3
Public Prop4
Output from first run (after clicking "Stop" in VBE):
Reset 0
Fill 0.34375
Second run:
Reset 8.601563 <<<<<
Fill 0.3554688

Creating a collection and some objects from a class

I have this Excel VBA code, and I just dont understand how the control flow works. It uses some kind of clever trick. Can someone help me fill in the details?
Basically, the code creates a collection, it creates some objects from a class "cls_FX", and fills the collection with the objects. Then there is a test which I dont understand. It looks like this. And nowhere has the string "Test" been added to the collection, as far as I can see. Can someone explain the code? What is the strategy of the strange test Err.Number=0? Why test with 0?
cls_FX:
Option Explicit
Public str_fx As String
Public col_Years As New Collection
Public str_Test As String
Code:
var_FX_Array = Array("USD", "GDP", "EUR")
For j = 0 To 3
Dim ci_cls_FX As New cls_FX
ci_cls_FX.str_fx = var_FX_Array(j)
col_FX.Add ci_cls_FX, ci_cls_FX.str_fx
Set ci_cls_FX = Nothing
Next j
str_fx = "USD"
Err.Clear
col_FX(str_fx).str_Test = "Test"
If Err.Number = 0 Then
str_Year = .Offset(i, 2)
....

How to run a sub in a `Create` function and how to make a mock/stub/fake for a chart `Series`?

Preface
About 10 years ago I started refactoring and improving the ChartSeries class of John Walkenbach. Unfortunately it seems that the original it is not available any more online.
Following the Rubberduck Blog for quite some time now I try to improve my VBA skills. But in the past I only have written -- I guess the experts would call it -- "script-like god-procedures" (because of not knowing better). So I am pretty new to classes and especially interfaces and factories.
Actual Questions
I try to refactor the whole class by dividing it into multiple classes also using interfaces and than also adding unit tests. For just reading the parts of a formula it would be sufficient to get the Series.Formula and then do all the processing. So it would be nice to call the Run sub in the Create function. But everything I tried so far to do so failed. Thus, I currently running Run in all Get properties etc. (and test, if the formula changed and exit Run than. Is this possible and when yes, how?
Second, to add unit tests -- of course using rubberduck for them -- I currently rely on real Charts/ChartObjects. How do I create a stub/mock/fake for a Series? (Sorry, I don't know the correct term.)
And here a simplified version of the code.
Many thanks in advance for any help.
normal module
'#Folder("ChartSeries")
Option Explicit
Public Sub ExampleUsage()
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets(1)
Dim crt As ChartObject
Set crt = wks.ChartObjects(1)
Dim srs As Series
Set srs = crt.Chart.SeriesCollection(3)
Dim MySeries As IChartSeries
Set MySeries = ChartSeries.Create(srs)
With MySeries
Debug.Print .XValues.FormulaPart
End With
End Sub
IChartSeries.cls
'#Folder("ChartSeries")
'#Interface
Option Explicit
Public Function IsSeriesAccessible() As Boolean
End Function
Public Property Get FullFormula() As String
End Property
Public Property Get XValues() As ISeriesPart
End Property
'more properties ...
ChartSeries.cls
'#PredeclaredId
'#Exposed
'#Folder("ChartSeries")
Option Explicit
Implements IChartSeries
Private Type TChartSeries
Series As Series
FullSeriesFormula As String
OldFullSeriesFormula As String
IsSeriesAccessible As Boolean
SeriesParts(eElement.[_First] To eElement.[_Last]) As ISeriesPart
End Type
Private This As TChartSeries
Public Function Create(ByVal Value As Series) As IChartSeries
'NOTE: I would like to run the 'Run' sub somewhere here (if possible)
With New ChartSeries
.Series = Value
Set Create = .Self
End With
End Function
Public Property Get Self() As IChartSeries
Set Self = Me
End Property
Friend Property Let Series(ByVal Value As Series)
Set This.Series = Value
End Property
Private Function IChartSeries_IsSeriesAccessible() As Boolean
Call Run
IChartSeries_IsSeriesAccessible = This.IsSeriesAccessible
End Function
Private Property Get IChartSeries_FullFormula() As String
Call Run
IChartSeries_FullFormula = This.FullSeriesFormula
End Property
Private Property Get IChartSeries_XValues() As ISeriesPart
Call Run
Set IChartSeries_XValues = This.SeriesParts(eElement.eXValues)
End Property
'more properties ...
Private Sub Class_Initialize()
With This
Dim Element As eElement
For Element = eElement.[_First] To eElement.[_Last]
Set .SeriesParts(Element) = New SeriesPart
Next
End With
End Sub
Private Sub Class_Terminate()
With This
Dim Element As LongPtr
For Element = eElement.[_First] To eElement.[_Last]
Set .SeriesParts(Element) = Nothing
Next
End With
End Sub
Private Sub Run()
If Not GetFullSeriesFormula Then Exit Sub
If Not HasFormulaChanged Then Exit Sub
Call GetSeriesFormulaParts
End Sub
'(simplified version)
Private Function GetFullSeriesFormula() As Boolean
GetFullSeriesFormula = False
With This
'---
'dummy to make it work
.FullSeriesFormula = _
"=SERIES(Tabelle1!$B$2,Tabelle1!$A$3:$A$5,Tabelle1!$B$3:$B$5,1)"
'---
.OldFullSeriesFormula = .FullSeriesFormula
.FullSeriesFormula = .Series.Formula
End With
GetFullSeriesFormula = True
End Function
Private Function HasFormulaChanged() As Boolean
With This
HasFormulaChanged = (.OldFullSeriesFormula <> .FullSeriesFormula)
End With
End Function
Private Sub GetSeriesFormulaParts()
Dim MySeries As ISeriesFormulaParts
'(simplified version without check for Bubble Chart)
Set MySeries = SeriesFormulaParts.Create( _
This.FullSeriesFormula, _
False _
)
With MySeries
Dim Element As eElement
For Element = eElement.[_First] To eElement.[_Last] - 1
This.SeriesParts(Element).FormulaPart = _
.PartSeriesFormula(Element)
Next
'---
'dummy which normally would be retrieved
'by 'MySeries.PartSeriesFormula(eElement.eXValues)'
This.SeriesParts(eElement.eXValues).FormulaPart = _
"Tabelle1!$A$3:$A$5"
'---
End With
Set MySeries = Nothing
End Sub
'more subs and functions ...
ISeriesPart.cls
'#Folder("ChartSeries")
'#Interface
Option Explicit
Public Enum eEntryType
eNotSet = -1
[_First] = 0
eInaccessible = eEntryType.[_First]
eEmpty
eInteger
eString
eArray
eRange
[_Last] = eEntryType.eRange
End Enum
Public Property Get FormulaPart() As String
End Property
Public Property Let FormulaPart(ByVal Value As String)
End Property
Public Property Get EntryType() As eEntryType
End Property
Public Property Get Range() As Range
End Property
'more properties ...
SeriesPart.cls
'#PredeclaredId
'#Folder("ChartSeries")
'#ModuleDescription("A class to handle each part of the 'Series' string.")
Option Explicit
Implements ISeriesPart
Private Type TSeriesPart
FormulaPart As String
EntryType As eEntryType
Range As Range
RangeString As String
RangeSheet As String
RangeBook As String
RangePath As String
End Type
Private This As TSeriesPart
Private Property Get ISeriesPart_FormulaPart() As String
ISeriesPart_FormulaPart = This.FormulaPart
End Property
Private Property Let ISeriesPart_FormulaPart(ByVal Value As String)
This.FormulaPart = Value
Call Run
End Property
Private Property Get ISeriesPart_EntryType() As eEntryType
ISeriesPart_EntryType = This.EntryType
End Property
Private Property Get ISeriesPart_Range() As Range
With This
If .EntryType = eEntryType.eRange Then
Set ISeriesPart_Range = .Range
Else
' Call RaiseError
End If
End With
End Property
Private Property Set ISeriesPart_Range(ByVal Value As Range)
Set This.Range = Value
End Property
'more properties ...
Private Sub Class_Initialize()
This.EntryType = eEntryType.eNotSet
End Sub
Private Sub Run()
'- set 'EntryType'
'- If it is a range then find the range parts ...
End Sub
'a lot more subs and functions ...
ISeriesParts.cls
'#Folder("ChartSeries")
'#Interface
Option Explicit
Public Enum eElement
[_First] = 1
eName = eElement.[_First]
eXValues
eYValues
ePlotOrder
eBubbleSizes
[_Last] = eElement.eBubbleSizes
End Enum
'#Description("fill me")
Public Property Get PartSeriesFormula(ByVal Element As eElement) As String
End Property
SeriesFormulaParts.cls
'#PredeclaredId
'#Exposed
'#Folder("ChartSeries")
Option Explicit
Implements ISeriesFormulaParts
Private Type TSeriesFormulaParts
FullSeriesFormula As String
IsSeriesInBubbleChart As Boolean
WasRunCalled As Boolean
SeriesFormula As String
RemainingFormulaPart(eElement.[_First] To eElement.[_Last]) As String
PartSeriesFormula(eElement.[_First] To eElement.[_Last]) As String
End Type
Private This As TSeriesFormulaParts
Public Function Create( _
ByVal FullSeriesFormula As String, _
ByVal IsSeriesInBubbleChart As Boolean _
) As ISeriesFormulaParts
'NOTE: I would like to run the 'Run' sub somewhere here (if possible)
With New SeriesFormulaParts
.FullSeriesFormula = FullSeriesFormula
.IsSeriesInBubbleChart = IsSeriesInBubbleChart
Set Create = .Self
End With
End Function
Public Property Get Self() As ISeriesFormulaParts
Set Self = Me
End Property
'#Description("Set the full series formula ('ChartSeries')")
Public Property Let FullSeriesFormula(ByVal Value As String)
This.FullSeriesFormula = Value
End Property
Public Property Let IsSeriesInBubbleChart(ByVal Value As Boolean)
This.IsSeriesInBubbleChart = Value
End Property
Private Property Get ISeriesFormulaParts_PartSeriesFormula(ByVal Element As eElement) As String
'NOTE: Instead of running 'Run' here, it would be better to run it in 'Create'
Call Run
ISeriesFormulaParts_PartSeriesFormula = This.PartSeriesFormula(Element)
End Property
'(replaced with a dummy)
Private Sub Run()
If This.WasRunCalled Then Exit Sub
'extract stuff from
This.WasRunCalled = True
End Sub
'a lot more subs and functions ...
You can already!
Public Function Create(ByVal Value As Series) As IChartSeries
With New ChartSeries <~ With block variable has access to members of the ChartSeries class
.Series = Value
Set Create = .Self
End With
End Function
...only, like the .Series and .Self properties, it has to be a Public member of the ChartSeries interface/class (the line is blurry in VBA, since every class has a default interface / is also an interface).
Idiomatic Object Assignment
A note about this property:
Friend Property Let Series(ByVal Value As Series)
Set This.Series = Value
End Property
Using a Property Let member to Set an object reference will work - but it isn't idiomatic VBA code anymore, as you can see in the .Create function:
.Series = Value
If we read this line without knowing about the nature of the property, this looks like any other value assignment. Only problem is, we're not assigning a value, but a reference - and reference assignments in VBA are normally made using a Set keyword. If we change the Let for a Set in the Series property definition, we would have to do this:
Set .Series = Value
And that would look much more readily like the reference assignment it is! Without it, there appears to be implicit let-coercion happening, and that makes it ambiguous code: VBA requires a Set keyword for reference assignments, because any given object can have a paraterless default property (e.g. how foo = Range("A1") implicitly assigns foo to the Value of the Range).
Caching & Responsibilities
Now, back to the Run method - if it's made Public on the ChartSeries class, but not exposed on the implemented IChartSeries interface, then it's a member that can only be invoked from 1) the ChartSeries default instance, or 2) any object variable that has a ChartSeries declared type. And since our "client code" is working off IChartSeries, we can guard against 1 and shrug off 2.
Note that the Call keyword is superfluous, and the Run method is really just pulling metadata from the encapsulated Series object, and caching it at instance level - I'd give it a name that sounds more like "refresh cached properties" than "run something".
Your hunch is a good one: Property Get should be a simple return function, without any side-effects. Invoking a method that scans an object and resets instance state in a Property Get accessor makes it side-effecting, which is a design smell - in theory.
If Run is invoked immediately after creation before the Create function returns the instance, then this Run method boils down to "parse the series and cache some metadata I'll reuse later", and there's nothing wrong with that: invoke it from Create, and remove it from the Property Get accessors.
The result is an object whose state is read-only and more robustly defined; the counterpart of that is that you now have an object whose state might be out of sync with the actual Excel Series object on the worksheet: if code (or the user) tweaks the Series object after the IChartSeries is initialized, the object and its state is stale.
One solution is to go out of your way to identify when a series is stale and make sure you keep the cache up-to-date.
Another solution would be to remove the problem altogether by no longer caching the state - that would mean one of two things:
Generating the object graph once on creation, effectively moving the caching responsibility to the caller: calling code gets a read-only "snapshot" to work with.
Generating a new object graph out of the series metadata, every time the calling code needs it: effectively, it moves the caching responsibility to the caller, which isn't a bad idea at all.
Making things read-only removes a lot of complexity! I'd go with the first option.
Overall, the code appears nice & clean (although it's unclear how much was scrubbed for this post) and you appear to have understood the factory method pattern leveraging the default instance and exposing a façade interface - kudos! The naming is overall pretty good (although "Run" sticks out IMO), and the objects look like they each have a clear, defined purpose. Good job!
Unit Testing
I currently rely on real Charts/ChartObjects. How do I create a stub/mock/fake for a Series? (Sorry, I don't know the correct term.)
Currently, you can't. When if/when this PR gets merged, you'll be able to mock Excel's interfaces (and much, much more) and write tests against your classes that inject a mock Excel.Series object that you can configure for your tests' purposes... but until then, this is where the wall is.
In the mean time, the best you can do is wrap it with your own interface, and stub it. In other words, wherever there's a seam between your code and Excel's object model, we slip an interface between the two: instead of taking in a Excel.Series object, you'd be taking in some ISeriesWrapper, and then the real code would be using an ExcelSeriesWrapper that works off an Excel.Series, and the test code might be using a StubSeriesWrapper whose properties return either hard-coded values, or values configured by tests: the code that works at the seam between the Excel library and your project, can't be tested - and we woulnd't want to anyway, because then we'd be testing Excel, not our own code.
You can see this in action in the example code for the next upcoming RD News article here; that article will discuss exactly this, using ADODB connections. The principle is the same: none of the 94 unit tests in that project ever open any actual connection, and yet with dependency injection and wrapper interfaces we're able to test every single bit of functionality, from opening a database connection to committing a transaction... without ever hitting an actual database.

Class constructor confusion - wrong number of arguments or invalid property assignment

I'm having a class module with some data:
Private sharedFolders() As String
Public Property Let SetSharedFolders(val As String)
Dim i As Integer
sharedFolders = Array("folder one", "folder two")
i = UBound(sharedFolders)
i = UBound(sharedFolders)
ReDim Preserve sharedFolders(i)
sharedFolders(i) = CStr(val)
End Property
Property Get GetSharedFolders()
GetSharedFolders = sharedFolders()
End Property
And I want to add something to this property from other module like this:
Sub PrepareData()
Dim e
Dim s
Dim a(2) As String
Set e = New Entry
a(0) = "add one"
a(1) = "add two"
For Each s In a
e.SetSharedFolders (s) 'Here comes exception
Next
For Each s In e.GetSharedFolders
Debug.Print s
Next
End Sub
But I receive an "wrong number of arguments or invalid property assignment vba" exception... Can anyone assist?
Addendum
Thanks to #AJD and #Freeflow to pointing out a mistake and idea to make it easier. Decided to make as like below.
Class Module:
Private sharedFolders As New Collection
Public Property Let SetSharedFolders(val As String)
If sharedFolders.Count = 0 Then ' if empty fill with some preset data and add new item
sharedFolders.Add "folder 1"
sharedFolders.Add "folder 2"
sharedFolders.Add CStr(val)
Else
sharedFolders.Add CStr(val)
End If
End Property
Property Get GetSharedFolders() As Collection
Set GetSharedFolders = sharedFolders
End Property
and regular module:
Sub AddData()
Dim e As New Entry ' creating an instance of a class
Dim s As Variant ' variable to loop through collection
Dim a(1) As String 'some array with data to insert
a(0) = "add one"
a(1) = "add two"
For Each s In a
e.SetSharedFolders = s
Next
For Each s In e.GetSharedFolders
Debug.Print s
Next
End Sub
Initially I thought the problem lies in this code:
i = UBound(sharedFolders)
i = UBound(sharedFolders)
ReDim Preserve sharedFolders(i)
sharedFolders(i) = CStr(val)
i is set twice to the same value, and then the sharedFolders is reDimmed to the same value it was before! Also, there is some trickery happening with the use of ix within a 0-based array.
But the problem is most likely how you have declared your variables.
For Each s In a
e.SetSharedFolders (s) 'Here comes exception
Next
s is a Variant, and a is a Variant. At this point VBA is trying to guess how to handle a For Each loop with two Variants. And then the improper call is made. The correct syntax is:
e.SetSharedFolders s '<-- no parenthesis
There are plenty of posts on StackOverflow explaining how to call routines and what the impact of the evaluating parenthesis are!
However, at this point we are only assuming it is passing in a single element of the array - it could be passing the full array itself (albeit unlikely).
And the third factor -
Public Property Let SetSharedFolders(val As String)
The parameter val is being passed ByRef and should be passed ByVal. This also has unintended side effects as I found out (Type mismatch trying to set data in an object in a collection).
Public Property Let SetSharedFolders(ByVal val As String)
All in all you have the perfect storm of ambiguity driving to an unknown result.
The answer here is to strongly type your variables. This removes about two layers of ambiguity and areas where errors can happen. In addition, this will slightly improve code execution.
Another aspect is to understand when you should pass something ByVal and when to use the default (preferably explicitly) ByRef.
And a final gratuitous hint: Use a Collection instead of an Array. Your code you have implies a Collection will be more efficient and easier to manage.
Addendum
(thanks to #FreeFlow):
If the OP changes the definition of sharedfolders to Variant rather than String() then the array statement will work as expected.
The line e.SetSharedFolders (s) will work fine if it is changed to e.SetSharedFolders = s because the method SetSharedFolders is a Let Property not a Sub. There are other errors but these two changes will make the code run.

VBA Customize collection object

I've been trying to learn how to create customized collections in Excel VBA and I found this piece of code on MSDN. While I understand most of it, can anyone tell me what the last code Set Add = empNew is doing? I don't understand it's comment. Thank you!
' Methods of the Employees collection class.
Public Function Add(ByVal Name As String, _
ByVal Salary As Double) As Employee
Dim empNew As New Employee
Static intEmpNum As Integer
' Using With makes your code faster and more
' concise (.ID vs. empNew.ID).
With empNew
' Generate a unique ID for the new employee.
intEmpNum = intEmpNum + 1
.ID = "E" & Format$(intEmpNum, "00000")
.Name = Name
.Salary = Salary
' Add the Employee object reference to the
' collection, using the ID property as the key.
mcolEmployees.Add empNew, .ID
End With
' Return a reference to the new Employee.
Set Add = empNew
End Function
You will notice that Add is the name of the Function. By issuing Set Add = newEmp your code is declaring that the return value (or object, in this case) of the function, is the newly created employee object newEmp. This means that the function will pass the variable newEmp back to its caller.
Say that you had some procedure calling your function, you would be able to do this:
Sub listEmployees
Dim e As Employee
' Create a new employee, and assign the variable e to point to this object
Set e = Add("John", 1000) ' Notice that the only reason we use "add" here is because it is the name of the function you provided
' e is now an Employee object, after being created in the line above, meaning we can access whatever properties is defined for it. The function Add lists some properties, so we can use those as examples.
Debug.Print e.Name
Debug.Print e.Salary
Debug.Print e.ID
End Sub
First, you need to define the new Type you have created, so put the following code on top of your module:
Public Type Employee
id As String
Name As String
Salary As Long
End Type
Then, inside your Public Function Add , change to Dim empNew As Employee.
Not sure why you need the following line : mcolEmployees.Add empNew, .id ??
and the last line modify to Add = empNew.
Then, when I test this Function from the following Sub:
Sub testEmp()
Dim s As Employee
s = Add("Shai", 50000)
End Sub
I get for s in the immediate window the following values:
s.id = E00001
s.Name = "Shai"
s.Salary = 50000
I hope this is what you intended in your post.

Resources