Instantiating objects within another class in Excel VBA - vba

I'm working on a project using Excel VBA where I have a number of datasets, each populated with a number of 'patients' which have a number of parameters (such as treatment, outcome etc.). To handle this, I intend to create a class called 'patient', with properties such as treatment and outcome. Then create a class called 'dataset', with a public property of 'patient'. I've created the classes, and I can instantiate a dataset object. But how do I go about instantiating patient object, or ideally an array of patient objects within the dataset object?
Dataset class module:
Private pNumber As Integer
Public Patient As Patient
Public Property Get Number() As Integer
Number = pNumber
End Property
Public Property Let Number(p As Integer)
pNumber = p
End Property
Patient class module:
Private pID As Integer
Private pTreatment As Boolean
Private pResponse As Single
Public Property Get ID() As Integer
ID = pID
End Property
Public Property Let ID(p As Integer)
pID = p
End Property
Public Property Get Treatment() As Boolean
Treatment = pTreatment
End Property
Public Property Let Treatment(p As Boolean)
pTreatment = p
End Property
Public Property Get Response() As Single
Response = pResponse
End Property
Public Property Let Response(p As Single)
pResponse = p
End Property
Main Module
Sub main()
Dim data1 As Dataset
Set data1 = New Dataset
'code to instantiate array of patient within data1 here
End Sub

The dataset will be better appointed something like this.
I would call the class what it is intended to be, so Patients:
private colPatients as new collection
public function add(aPatient as patient)
colPatients.add aPatient, aPatient.Id
end function
public property get count() as long
count = colPatients.count
end property
public property get items() as collection
set items = colPatients
end property
public property get item(vItem as variant) as patient
set item = colPatients(vItem)
end property
public sub remove(vItem as variant)
colPatients.remove vItem
end sub
So to use:
dim patientCollection as patients
Sub main()
Set patientCollection = New patients
'code to instantiate array of patient within data1 here
IDs = Array(1,2,3)
treats = array("x","y","z")
dim x as integer
dim p as patient
for x = lbound(IDs) to Ubound(IDs)
set p= new patient
p.id = IDs(x)
p.treatment = treats(x)
patientCollection.add p
set p = nothing
next x
End Sub

Related

Assign custom class instance to variable with get-Function

I have two classes:
clsDataElement
Public dataA As String
Public dataB As String
Public dataC As String
clsInterface
Private mDataElements() As clsDataElement
Private mCountOfDataElements As Integer
Private Sub Class_Initialize()
mCountOfDataElements = 0
End Sub
Public Sub addDataElement(dataElement As clsDataElement)
ReDim Preserve mDataElements(mCountOfDataElements)
Set mDataElements(mCountOfDataElements) = New clsDataElement
mDataElements(mCountOfDataElements).dataA = dataElement.dataA
mDataElements(mCountOfDataElements).dataB = dataElement.dataB
mDataElements(mCountOfDataElements).dataC = dataElement.dataC
mCountOfDataElements = mCountOfDataElements + 1
End Sub
Public Function getDataElement(Optional index As Integer) As clsDataElement
If Not index >= mCountOfDataElements Then
getDataElement = mDataElements(index)
End If
End Function
So as you can see, the class clsDataElement is just a containe for some data.
The class clsInterface can contain multiple Elements of clsDataElement
Now if I want to read one Data Element from the interface class, it just does not work. However, I feel like this is related to the fact, that I cannot just assign custom classes:
Public Sub TestMyClass(myInterface As clsInterface)
Dim tmpDataElement As New clsDataElement
Set tmpDataElement = myInterface.getDataElement(0)
End Sub
So when running this code I get the error
Object variable or with block variable not set
I made sure that there are multiple data elements stored in myInterface.
Do you have any ideas what I am doing wrong?
Aren't you missing the 'Set' keyword when getting the element:
Public Function getDataElement(Optional index As Integer) As clsDataElement
If Not index >= mCountOfDataElements Then
Set getDataElement = mDataElements(index)
End If
End Function

Filter List of Class by Property Value and List Of Value

I have a Devexpress Gridcontrol bound to a custom class.
The class looks like this:
Public Class AuditList
Public CasualtyList As List(Of CasualtyRecords)
Public MedsList As List(Of CasualtyRecords.Medications)
Public Property FilterString As CriteriaOperator
Public Sub New()
CasualtyList = New List(Of CasualtyRecords)
MedsList = New List(Of CasualtyRecords.Medications)
End Sub
Public Class CasualtyRecords
Private _primary As New PS
Public Property PrimarySurvey As PS
Get
Return _primary
End Get
Set(value As PS)
_primary = value
End Set
End Property
Public Sub New()
Vitals = New List(Of VitalRecords)
End Sub
Public Property Vitals As List(Of VitalRecords)
Public Property Meds As List(Of Medications)
ReadOnly Property MedCount As Integer
Get
Return Meds.Count
End Get
End Property
Property Id As Integer
Property ClinicalImpression As String
Property Disposal As String
Property Age As Integer
Property Gender As String
Class PS
Public Property Airway As Integer
Public Property Breathing As Integer
Public Property Circulation As Integer
Public Property Rate As Integer
End Class
Class Medications
Public Property MedName As String
End Class
End Class
End Class
This is an example of a filter type I am trying to create:
"[Gender] ='Male' AND [Medications].[MedName] = 'Paracetamol' AND [Age] >100"
Is this possible with the class constructed as shown, or perhaps do I need to implement some other interface?
I imagine that it would look something like this with LINQ
Dim b As New CasualtyRecords
b = a.CasualtyList.Where(Function(x) x.Meds.Any(Medications.Med = "Paracetamol") And x.Gender = "Male" And x.Age > 20)
Thanks
I was able to achieve the required results using this LINQ query
Dim newrecords = a.CasualtyList.Where(
Function(x) x.Meds.Any(
Function(b) b.MedName = "Paracetamol") _
And x.Gender = "Male" And x.Age > 20).ToList()

VB.NET Object with custom name to store property?

I'm not familiar with the type of structure or whatever I need to use to achieve this, but I know that there is one.
I'm trying to make it so that I can reference things something like this:
racerlist(x).compatibilityArr.john.CleatScore
instead of what I have to do now:
racerlist(x).compatibilityArr.CleatScoreArr(y).name/.score
So essentially, I want to add items to the compatibilityarr (will probably have to change to a list which is fine) and be able to reference the racer as their own name, instead of by using an index.
This is one way to build a solution that fits your needs as described above. It requires an embedded class that is built as a List(Of T) where we overload the property to accept a string rather than the integer.
Public Class Foo
Public Property compatibilityArr As New Members
End Class
Public Class Members : Inherits List(Of Member)
Public Overloads ReadOnly Property Item(name As String) As Member
Get
Return Me.Where(Function(i) i.Name = name).FirstOrDefault
End Get
End Property
End Class
Public Class Member
Public Property Name As String
Public Property CleatScore As Integer
End Class
Then to use it:
Public Class Form1
Dim f As New Foo
Private Sub loads() Handles Me.Load
Dim member As New Member With {.Name = "John", .CleatScore = 10}
f.compatibilityArr.Add(member)
MessageBox.Show(f.compatibilityArr.Item("John").CleatScore)
End Sub
End Class
There are other ways to do this, but the simplest is to write a function to search the array by name:
Sub Main1()
Dim racerlist(2) As Racer
racerlist(0) = New Racer With {.Name = "Adam", .CleatScore = "1"}
racerlist(1) = New Racer With {.Name = "Bill", .CleatScore = "2"}
racerlist(2) = New Racer With {.Name = "Charlie", .CleatScore = "3"}
For i As Integer = 0 To racerlist.GetUpperBound(0)
For j As Integer = 0 To racerlist.GetUpperBound(0)
If racerlist(j).Name <> racerlist(i).Name Then
ReDim Preserve racerlist(i).CompatibilityArr(racerlist(i).CompatibilityArr.GetUpperBound(0) + 1)
racerlist(i).CompatibilityArr(racerlist(i).CompatibilityArr.GetUpperBound(0)) = racerlist(j)
End If
Next j
Next i
Dim racerBill As Racer = Racer.FindRacer(racerlist, "Bill")
MsgBox(racerBill.FindCompatibility("Charlie").CleatScore)
End Sub
Class Racer
Property Name As String
Property CleatScore As String
Property CompatibilityArr As Racer()
Sub New()
ReDim CompatibilityArr(-1) 'initialise the array
End Sub
Function FindCompatibility(name As String) As Racer
Return FindRacer(CompatibilityArr, name)
End Function
Shared Function FindRacer(racerlist() As Racer, name As String) As Racer
For i As Integer = 0 To racerlist.GetUpperBound(0)
If racerlist(i).Name = name Then
Return racerlist(i)
End If
Next i
Return Nothing
End Function
End Class
As #Codexer mentioned, I used a dictionary to achieve this.
In my list of Racers (RacerList), I have RacerCompatibility, which I created similar to below:
Public RacerCompatibility As New Dictionary(Of String, Compatibility)
Compatibility is created like:
Public Class Compatibility
Public Cleat As Boolean
Public Skill As Integer
Public Height As Integer
End Class
So now I can access the compatibility of a racer inside the list like:
RacerList(x).RacerCompatibility.Item("John")

Collection class of specific type containing basic features

Every time i use some class e.g Artikel as follows:
Public Class Artikel
Property ID As Integer
Property Nummer As String
Property Name As String
Property Position As Integer
End Class
For such classes i would like to have collection class. The features i would like to have is like:
--> Add (passing Artikel object)
--> Remove (passing Artikel object)
--> Sort entire collection (based on Position property desc/asc)
--> Compare two Artikels (pass by Artikels and tell by which property has to be compared)
--> Check whether two artikels equals
--> Every added artikel has to be marked by Key (so maybe dictionary)? <key><Artikel>
--> Remove Artikel (passing by Key index)
Could somone from you there tell me or even better provide example of collection class pass those requirments?
EDIT: Startup:
Artikel's collection:
Option Strict On
Public Class Articles
Public Property collection As Dictionary(Of Integer, Artikel)
Sub New()
'Initiate new collection
collection = New Dictionary(Of Integer, Artikel)
End Sub
'Add new Artikel to collection
Public Function AddToCollection(ByVal artikel As Artikel) As Boolean
collection.Add(artikel)
Return True
End Function
'Remove specific Artikel
Public Sub RemoveFromCollectionByArtikel(artikel As Artikel)
If Not IsNothing(collection) Then
collection.Remove(artikel)
End If
End Sub
'Get collection
Public Function GetCollection() As Dictionary(Of Integer, Artikel)
Return collection
End Function
'Sort collection by property position
Public Sub SortByPosition()
collection.Sort()
End Sub
'Remove specific sending keys and then reorder them
Public Sub RemoveAllMarkedAsDeleted(keys As List(Of Integer))
'-- Check whther anything has been marked as deleted
If keys.Count > 0 Then
For Each row In keys
collection.Remove(row)
Next
ReorderKeys()
End If
'Reorder all Artikels in collection
Private Sub ReorderKeys()
Dim newCollection As New Dictionary(Of Integer, Artikel)
Dim index As Integer = 0
For Each collitem In collection
newCollection.Add(index, collitem.Value)
index += 1
Next
collection.Clear()
collection = newCollection
End Sub
End Class
Artikel class (additionally i implemented IComparable to be able to sort)
Option Strict On
Public Class Artikel
Implements IComparable(Of Artikel)
Property ID As Integer
Property Nummer As String
Property Name As String
Property Position As Integer
Public Function CompareTo(pother As Artikel) As Integer Implements IComparable(Of Artikel).CompareTo 'we can sort because of this
Return String.Compare(Me.Position, pother.Position)
End Function
Public Shared Function FindPredicate(ByVal partikel As Artikel) As Predicate(Of Artikel)
Return Function(partikel2 As Artikel) partikel.ID = partikel2.ID
End Function
Public Shared Function FindPredicateByUserId(ByVal partikel As String) As Predicate(Of Artikel)
Return Function(partikel2 As Artikel) partikel = partikel2.ID
End Function
End Class
Parts of it look good, but I would ultimately do it a bit differently. First, consider overloads on the item class to make them easier to create and default initialization:
Public Class Article
Property ID As Integer = -1
Property Key As String = ""
Property Name As String = ""
Property Position As Integer = -1
Property PubDate As DateTime = DateTime.Minimum
Public Sub New()
End Sub
' whatever minimum data a new item requires
Public Sub New(k As String, n As String)
Key = k
Name = n
End Sub
' full initialization:
Public Sub New(k As String, n As String, pos As Int32,
pubDt As DateTime)
...
End Sub
End Class
I added some properties for variety, and I suspect "Nummer" might be the "Key" mentioned in the OP, but whatever it is, I would add it to the Article class as that name, if it has some importance.
You might need a simple ctor for serialization (???). Some of these will find and use a Private parameterless constructor, but your code will be forced to use one of the overloads in order to provide some minimum level of data when a new one is created.
You probably do not need IComparable. That is typically for more complex comparisons, such as multiple or complex properties. An example is a carton or box:
If (width = Other.Width) AndAlso (height = Other.Height) Then
Return 0
ElseIf (width = Other.Height) AndAlso (height = Other.Width) Then
Return 0
End If
Plus more gyrations to work out which is "less" than the other. One reason you dont need it, is because If Art1.Postion > Art2.Postion is trivial. The other reason in your case, is because a Dictionary cannot be sorted.
Rather than a Dictionary, an internal List would work better for some of the things you describe but still allow you to have it act like a Dictionary to the extent you need it to. For this, I might build it using ICollection<T>:
Public Class ArticleCollection
Implements ICollection(Of Article)
Pressing Enter after that line will add all the required methods including:
Public Sub Add(item As Article) Implements ICollection(Of Article).Add
Public Sub Clear() Implements ICollection(Of Article).Clear
Public Function Contains(item As Article) As Boolean Implements ICollection(Of Article).Contains
Public ReadOnly Property Count As Integer Implements ICollection(Of Article).Count
Public Function Remove(item As Article) As Boolean Implements ICollection(Of Article).Remove
It remains completely up to you how these are implemented. It also doesn't rule out adding methods such as RemoveAt(int32) or RemoveByKey(string) depending on what you need/how it will be used. One of the benefits to ICollection(Of T) is that it includes IEnumerable which will allow use for each loops (once you write the Enumerator): For Each art In Articles
To emulate a dictionary to allow only one item with a specific property value:
Public Class ArticleCollection
Implements ICollection(Of Article)
Private mcol As List(Of Article)
...
Public Sub Add(item As Article) Implements ICollection(Of Article).Add
' check for existing key
If KeyExists(item.Key) = False Then
mcol.Add(item)
End If
End Sub
You can also overload them:
' overload to match Article ctor overload
Public Sub Add(key As String, name As String)
If KeyExists(key) = False Then
' let collection create the new item
' with the minimum required info
mcol.Add(New Article(key, name))
End If
End Sub
If you add an Item Property, you can index the collection ( Articles(3) ):
Property Item(ndx As Int32) As Article
Get
If ndx > 0 AndAlso ndx < mcol.Count Then
Return mcol(ndx)
Else
Return Nothing
End If
End Get
Set(value As Article)
If ndx > 0 AndAlso ndx < mcol.Count Then
mcol(ndx) = value
End If
End Set
End Property
' overload for item by key:
Public Property Item(key As String) As Article
An Add method and an Item Property will be important if the collection will display in the standard NET CollectionEditor.
There are several ways to implement sorting. The easiest is to use linq in the code which uses your collection:
Articles = New ArticleCollection
' add Article items
Dim ArticlesByDate = Articles.OrderBy(Function(s) s.PubDate).ToList()
Where PubDate is one of the Article properties I added. The other way to handle sorting is by the collection class returning a new collection (but it is so simple to do, there is little need for it):
Friend Function GetSortedList(bSortAsc As Boolean) As List(Of Article)
If bSortAsc Then
Return mcol.OrderBy(Function(q) q.PubDate).
ThenBy(Function(j) j.Position).ToList()
Else
Return mcol.OrderByDescending(Function(q) q.PubDate).
ThenByDescending(Function(j) j.Position).ToList()
End If
End Function
Whether it implements ICollection(Of T), inherits from ICollection(Of T) or does work off a Dictionary depends entirely on what this is, how it is used and whatever rules and restrictions there are (including if it will be serialized and how). These are not things we know.
MSDN has an article on Guidelines for Collections which is excellent.
Create your class
Public Class Artikel
Property ID As Integer
Property Nummer As String
Property Name As String
Property Position As Integer
sub new (_ID as integer, _Nummer as string, _Name as string, _Position as integer)
ID = _ID
Nummer = _Nummer
Name = _Name
Position = _Position
End Sub
End Class
Create another class which holds a private list and add sub routines to it
Public Class ArtikelList
Private _List as new list (of Artikel)
Public sub remove(Key as integer)
Dim obj as Artikel = nothing
for each x as Artikel in _List
if x.ID = Key then
obj = x
exit for
end if
Next
if not isnothing(obj) then
_List.remove(obj)
end if
End sub
Sub Add(obj as Artikel)
Dim alreadyDeclared as boolean = falsse
for each x as Artikel in _List
if x.ID = obj.id then
alreadyDeclared = true
exit for
end if
Next
if not AlreadyDeclared then
_List.add(obj)
Else
'Somehow inform the user of the duplication if need be.
end if
End sub
End Class
Then use your list class.
dim L as new ArtikelList
L.add(new Artikel(1280, "AFKforever!", "Prof.FluffyButton", 96))
L.remove(1280)
I only added one sub routine as an example. I hope it helps but feel free to ask for more example routines.
This can also be done by creating a class which inherits from the list class, exposing all list class functionality but by using this method you are forced to create every subroutine that will be used. This way you only use routines that you created exclusively for the purpose Artikel objects handling.
Check if two Artikels are equal
Public Class Artikel
Property ID As Integer
Property Nummer As String
Property Name As String
Property Position As Integer
sub new (_ID as integer, _Nummer as string, _Name as string, _Position as integer)
ID = _ID
Nummer = _Nummer
Name = _Name
Position = _Position
End Sub
End Class
Public Overrides Overloads Function Equals(obj As Object) As Boolean
If obj Is Nothing OrElse Not Me.GetType() Is obj.GetType() Then
Return False
else
dim _obj as artikel = obj
if Me.ID = _obj.ID then
Return true
else Return False
End If
End Function
End Class
Use it like:
If x.equals(y) then
'they have the same ID
end if

Declare and and define Property in VB

I have two Class and I want to save my data into arrays form text box like this:
Students.Name(txtID.Text-1).MathMark = txtMark.Text
but I get error: Object reference not set to an instance of an object
my code is:
Dim StudentsNumber as Integer = txtstdnum.Text
Dim Students as New StudentsInf(StudentsNumber)
Students.Name(txtID.Text-1).MathMark = txtMark.Text
Public Class StudentsInf
Private mName() As String
Sub New(ByVal StudentNumbers As Integer)
ReDim mName(StudentNumbers-1)
End Sub
Public Property Name(ByVal Index As Integer) As LessonsMark
Get
Return mName(Index)
End Get
Set(ByVal Value As LessonsMark)
mName(Index) = Value
End Set
End Property
End Class
Public Class LessonsMark
Private mMathMark() As Object
Public Property MathMark() As Object
Get
Return mMathMark
End Get
Set(ByVal Value As Object)
mMathMark = Value
End Set
End Property
End Class
This:
Private mName() As String
needs to be:
Private mName() As LessonsMark
then you have to create the objects in your constructor, something like:
Sub New(ByVal StudentNumbers As Integer)
ReDim mName(StudentNumbers - 1)
For i As Integer = 0 To StudentNumbers - 1
mName(i) = New LessonsMark()
Next
End Sub
then it looks like your LessonsMark class is declaring an array of objects when it looks like it should be just a string property:
Public Class LessonsMark
Private mMathMark As String
Public Property MathMark As String
Get
Return mMathMark
End Get
Set(ByVal Value As String)
mMathMark = Value
End Set
End Property
End Class