Is it possible to assign UDT as item of collection/dictionary?

G

gifariz

Board Regular
Joined
May 2, 2021
Messages
120
Office Version
  1. 365
Platform
  1. Windows
As title, is it possible to assign UDT as item of collection/dictionary?
I want to have array-like complex UDT structure and call it by key.
This is continuous question from my previous post: Is there a way to call array member by key instead of index?

Here is my attempt:
VBA Code: 
Sub SampleSub()

    Dim ArrayA As tSampleType
    Dim ArrayAs() As tSampleType
    Dim ArrayA_IDs As New Collection
    Dim ColA As New Collection
    Dim i As Long, nData As Long, Name As String, DataX As Double
    
    'Store array
    ReDim ArrayAs(99)
    For i = 0 To 99
        With ArrayAs(i)
             .Name = "abc" & i
             ArrayA_IDs.Add i, .Name
             nData = 1000
             ReDim .DataX(nData - 1), .DataY(nData - 1), .DataS(nData - 1)
             'and so on
        End With
    Next i

    'Calling array member by key
    'Success but mouthful (having to have separate ArrayAs and ArrayA_IDs variable)
    Name = "abc0"
    i = ArrayA_IDs(Name)
    DataX = ArrayAs(i).DataX(123)
    
    'Attempt to make UDT as item of collection
    For i = 0 To 99
        ColA.Add ArrayAs(i), ArrayAs(i).Name
    Next i
    'Simple single line access to UDT by key
    DataX = ColA(Name).DataX(123)
    'And moving forward, I can bypass only ColA to other subs/functions, not a set of ArrayAs and Array_IDs

End Sub

It shows error: "Compile error: Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound function".

Or... is it possible to make my own custom class that is similar with collection/dictionary object that can assign any types of UDT as item (not making one class for one UDT) and access it by key? (Maybe this can be question for another post). I actually have never make custom class yet, so its better if its possible without making class.

Thank you in advance.
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
UDT's are notriously problematic. If you need objects with properties, it would be best to do that all in custom classes rather than a UDT.
 
Upvote 0
mikerickson said:
UDT's are notriously problematic. If you need objects with properties, it would be best to do that all in custom classes rather than a UDT.
Click to expand...
Thank you for you feedback. I will start seriously studying Class & OOP then.
 
Upvote 0
I have encountered similar situations in the past where I wanted to pass a UDT to a collection... In those situations, I have used a workaround by passing the address of the UDT variable to the collection instead of passing the actual UDT... Later on, when ready to retrieve the actual data stored in the UDT , I just dereference the address pointer using the RtlMoveMemory api function.

This is not perfect as the UDT vars must not lose scope (ie: They must be declared as Module level or Public vars) and the UDT string members must be of fixed size.

Anyways, here is an example that illustrates the point and shows how you can call the UDT from the collection by Key :

VBA Code: 
Option Explicit

#If VBA7 Then
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As LongPtr) As Long
#Else
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
#End If

Type Parents
    MotherName As String * 32
    FatherName  As String * 32
End Type

Type Person
    Name As String * 32
    Surname  As String * 32
    Country  As String * 32
    DateOfBirth As Date
    Salary As Double
    PersonParents As Parents
End Type

Dim oPersColl As Collection
Dim Person1 As Person
Dim Person2 As Person


Sub TEST()

    'Populate UDT members.
    With Person1
        .Name = "John" & vbNullChar
        .Surname = "Peterson" & vbNullChar
        .DateOfBirth = #11/10/1980#
        .Salary = 3580.8
        .Country = "Uk" & vbNullChar
        .PersonParents.FatherName = "Peter" & vbNullChar
        .PersonParents.MotherName = "Nancy" & vbNullChar
    End With
  
    With Person2
        .Name = "Anil" & vbNullChar
        .Surname = "Kumar" & vbNullChar
        .DateOfBirth = #1/5/1978#
        .Salary = 5000
        .Country = "India" & vbNullChar
        .PersonParents.FatherName = "Udut" & vbNullChar
        .PersonParents.MotherName = "Asha" & vbNullChar
    End With
  
  
    'Store Address of UDT vars in Collection passing *Name* member as key
    Set oPersColl = New Collection
    oPersColl.Add VarPtr(Person1), Key:=Person1.Name
    oPersColl.Add VarPtr(Person2), Key:=Person2.Name


    'Retrieving UDTs members by key [key = Name of the Person]
    Dim P1 As Person
    Dim P2 As Person
  
    P1 = GetUDTByKey(oPersColl, Key:="John")
  
    Debug.Print "P1  [John]"
    Debug.Print "======="
    With P1
        Debug.Print "Name: " & TrimStringMember(.Name)
        Debug.Print "Surname: " & TrimStringMember(.Surname)
        Debug.Print "Country: " & TrimStringMember(.Country)
        Debug.Print "Date Of Birth: " & .DateOfBirth
        Debug.Print "Salary: $" & .Salary
        Debug.Print "Father name : " & TrimStringMember(.PersonParents.FatherName)
        Debug.Print "Mother name:" & TrimStringMember(.PersonParents.MotherName)
    End With
  
  
    Debug.Print
    Debug.Print
  
  
    P2 = GetUDTByKey(oPersColl, Key:="Anil")
  
    Debug.Print "P2  [Anil]"
    Debug.Print "======="
    With P2
        Debug.Print "Name: " & TrimStringMember(.Name)
        Debug.Print "Surname: " & TrimStringMember(.Surname)
        Debug.Print "Country: " & TrimStringMember(.Country)
        Debug.Print "Date Of Birth: " & .DateOfBirth
        Debug.Print "Salary: $" & .Salary
        Debug.Print "Father name : " & TrimStringMember(.PersonParents.FatherName)
        Debug.Print "Mother name:" & TrimStringMember(.PersonParents.MotherName)
    End With

End Sub

Function GetUDTByKey(ByVal oColl As Collection, ByVal Key As String) As Person

    Key = Replace(Key, vbNullChar, "")
    Key = Key & vbNullChar & String(31 - Len(Key), " ")
  
    #If Win64 Then
        Dim lPtr As LongLong
        lPtr = CLngLng(oColl(Key))
    #Else
        Dim lPtr As Long
        lPtr = CLng(oColl(Key))
    #End If
  
    If IsBadCodePtr(lPtr) = 0 Then
        CopyMemory ByVal VarPtr(GetUDTByKey), ByVal lPtr, LenB(GetUDTByKey)
    End If

End Function

Function TrimStringMember(ByVal Str As String)
    Dim lNullCharPos  As Long
    lNullCharPos = InStr(1, Str, vbNullChar, vbTextCompare)
    If lNullCharPos Then
        TrimStringMember = Left(Str, lNullCharPos - 1)
    End If
End Function
 
Upvote 0
Solution
Jaafar Tribak said:
I have encountered similar situations in the past where I wanted to pass a UDT to a collection... In those situations, I have used a workaround by passing the address of the UDT variable to the collection instead of passing the actual UDT... Later on, when ready to retrieve the actual data stored in the UDT , I just dereference the address pointer using the RtlMoveMemory api function.

This is not perfect as the UDT vars must not lose scope (ie: They must be declared as Module level or Public vars) and the UDT string members must be of fixed size.

Anyways, here is an example that illustrates the point and shows how you can call the UDT from the collection by Key :

VBA Code: 
Option Explicit

#If VBA7 Then
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As LongPtr) As Long
#Else
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
#End If

Type Parents
    MotherName As String * 32
    FatherName  As String * 32
End Type

Type Person
    Name As String * 32
    Surname  As String * 32
    Country  As String * 32
    DateOfBirth As Date
    Salary As Double
    PersonParents As Parents
End Type

Dim oPersColl As Collection
Dim Person1 As Person
Dim Person2 As Person


Sub TEST()

    'Populate UDT members.
    With Person1
        .Name = "John" & vbNullChar
        .Surname = "Peterson" & vbNullChar
        .DateOfBirth = #11/10/1980#
        .Salary = 3580.8
        .Country = "Uk" & vbNullChar
        .PersonParents.FatherName = "Peter" & vbNullChar
        .PersonParents.MotherName = "Nancy" & vbNullChar
    End With
 
    With Person2
        .Name = "Anil" & vbNullChar
        .Surname = "Kumar" & vbNullChar
        .DateOfBirth = #1/5/1978#
        .Salary = 5000
        .Country = "India" & vbNullChar
        .PersonParents.FatherName = "Udut" & vbNullChar
        .PersonParents.MotherName = "Asha" & vbNullChar
    End With
 
 
    'Store Address of UDT vars in Collection passing *Name* member as key
    Set oPersColl = New Collection
    oPersColl.Add VarPtr(Person1), Key:=Person1.Name
    oPersColl.Add VarPtr(Person2), Key:=Person2.Name


    'Retrieving UDTs members by key [key = Name of the Person]
    Dim P1 As Person
    Dim P2 As Person
 
    P1 = GetUDTByKey(oPersColl, Key:="John")
 
    Debug.Print "P1  [John]"
    Debug.Print "======="
    With P1
        Debug.Print "Name: " & TrimStringMember(.Name)
        Debug.Print "Surname: " & TrimStringMember(.Surname)
        Debug.Print "Country: " & TrimStringMember(.Country)
        Debug.Print "Date Of Birth: " & .DateOfBirth
        Debug.Print "Salary: $" & .Salary
        Debug.Print "Father name : " & TrimStringMember(.PersonParents.FatherName)
        Debug.Print "Mother name:" & TrimStringMember(.PersonParents.MotherName)
    End With
 
 
    Debug.Print
    Debug.Print
 
 
    P2 = GetUDTByKey(oPersColl, Key:="Anil")
 
    Debug.Print "P2  [Anil]"
    Debug.Print "======="
    With P2
        Debug.Print "Name: " & TrimStringMember(.Name)
        Debug.Print "Surname: " & TrimStringMember(.Surname)
        Debug.Print "Country: " & TrimStringMember(.Country)
        Debug.Print "Date Of Birth: " & .DateOfBirth
        Debug.Print "Salary: $" & .Salary
        Debug.Print "Father name : " & TrimStringMember(.PersonParents.FatherName)
        Debug.Print "Mother name:" & TrimStringMember(.PersonParents.MotherName)
    End With

End Sub

Function GetUDTByKey(ByVal oColl As Collection, ByVal Key As String) As Person

    Key = Replace(Key, vbNullChar, "")
    Key = Key & vbNullChar & String(31 - Len(Key), " ")
 
    #If Win64 Then
        Dim lPtr As LongLong
        lPtr = CLngLng(oColl(Key))
    #Else
        Dim lPtr As Long
        lPtr = CLng(oColl(Key))
    #End If
 
    If IsBadCodePtr(lPtr) = 0 Then
        CopyMemory ByVal VarPtr(GetUDTByKey), ByVal lPtr, LenB(GetUDTByKey)
    End If

End Function

Function TrimStringMember(ByVal Str As String)
    Dim lNullCharPos  As Long
    lNullCharPos = InStr(1, Str, vbNullChar, vbTextCompare)
    If lNullCharPos Then
        TrimStringMember = Left(Str, lNullCharPos - 1)
    End If
End Function
Click to expand...
Wow thank you very much. It looks awesome. Let me try to implement and see which method is most effective in long run.
 
Upvote 0
mikerickson said:
UDT's are notriously problematic. If you need objects with properties, it would be best to do that all in custom classes rather than a UDT.
Click to expand...
Classes are a pain in their own right. 1) You can't pass a class member to a procedure as a ByRef argument, and you won't get any compile or runtime errors if you do - it just won't work. 2) You need to code accessor functions for every property. So you can't just add a field to a structure.

IMHO if you don't need methods, UDTs are fine. If you need to pass 'em around, stick 'em in a collection or array and pass the index around.

UDTs are like structs in C - add a few elements, and you're done. Classes are like C++ classes - tons of code to basically get a struct with methods.

Tom
 
Upvote 0
TomTheToolman said:
2) You need to code accessor functions for every property. So you can't just add a field to a structure.
Click to expand...
I don't follow. You can simply add public variables to a class, so I'm not sure what you mean by that statement?
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Is there a way to call array member by key instead of index?
Replies
4
Views
587
gifariz
G
Edgar_
  • Question Question
Finding the right arguments for Windows API
Replies
2
Views
259
Edgar_
Edgar_
J
  • Question Question
Use of CopyMem for Collection
Replies
0
Views
364
Juggler_IN
J
J
  • Solved
Sort VB Dictionary with Keys in "MMM-DD" format
Replies
2
Views
484
jammerules
J
D
  • Question Question
Code taking too long to run, unsure of the cause or the resolution
Replies
3
Views
492
offthelip
O

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top