Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

User defined types in arrays/collections and for each loops

Tags:

types

foreach

vba

VBA shows in a popup that i am not allowed to iterate through an array with user defined types. I wrote a bit of code and wonder how i can work around this. Here is a mini example that focusses on what i want to be able to do.

Option Explicit

Type Info
    source As String
    destination As String
End Type

Sub specialCopy()
    Dim target As Variant
    Dim AllTargets() As Info: AllTargets = SetAllTargets()
    For Each target In AllTargets
        CopyValues (target)
    Next
End Sub

Function SetAllTargets() As Info()
    Dim A As Info: A = SetInfo("A1", "B1")
    Dim B As Info: B = SetInfo("A2", "B2")
    Dim AllTargets() As Info
    Set AllTargets = Array(A, B)
End Function

Function SetInfo(source As String, target As String) As Info
    SetInfo.source = source
    SetInfo.destination = destination
End Function

Sub CopyValues(target As Info)
    Range(target.source).Select
    Selection.Copy
    Range(target.destination).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

How can i iterate through my AllTargets array? Since i am unable to compile this there may be more than one problem here. I am not entirely sure if the way i set up the AllTargets list is a valid syntax.


I reworked the example to narrow down the problems in the code:

Option Explicit

Type Info
    source As String
    destination As String
End Type

Sub specialCopy()
    Dim target As Variant
    Dim AllTargets As Collection: Set AllTargets = SetAllTargets()
    For Each target In AllTargets
        CopyValues (target) '2. unkown if this is possible
    Next
End Sub

Function SetAllTargets() As Collection
    Dim A As Info: A = SetInfo("A1", "B1")
    Dim B As Info: B = SetInfo("A2", "B2")
    Set SetAllTargets = New Collection
    SetAllTargets.Add (A) '1. problem here when assigning user type
    SetAllTargets.Add (B) '1. problem here when assigning user type
End Function

Function SetInfo(source As String, destination As String) As Info
    SetInfo.source = source
    SetInfo.destination = destination
End Function

Sub CopyValues(target As Info)
    Range(target.source).Select
    Selection.Copy
    Range(target.destination).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

The code went from Array to Collection - never the less there are still issues in it that i can not solve now.

I think the root cause stayed the same: using user defined types. I marked as a comment where i think the problems are located.

like image 672
Johannes Avatar asked Jul 25 '14 11:07

Johannes


1 Answers

You can't add UDTs to collections or dictionaries. I don't know why, but it's inherent in the language. You can make a simple custom class that does the same thing as the UDT. I never use UDTs any more and just create a class to avoid these strange limitations.

Create a new class module (Insert - Module). Go to the properties sheet (F4) and change the name property to CInfo.

In a class CInfo

Private mSource As String
Private mDestination As String

Public Property Get Source() As String
    Source = mSource
End Property

Public Property Let Source(rhs As String)
    mSource = rhs
End Property

Public Property Get Destination() As String
    Destination = mDestination
End Property

Public Property Let Destination(rhs As String)
    mDestination = rhs
End Property

In a standard module

Sub specialCopy()
    Dim target As Variant
    Dim AllTargets As Collection: Set AllTargets = SetAllTargets()
    For Each target In AllTargets
        CopyValues target '2. unkown if this is possible
    Next
End Sub

Function SetAllTargets() As Collection
    Dim A As CInfo: Set A = SetInfo("A1", "B1")
    Dim B As CInfo: Set B = SetInfo("A2", "B2")
    Set SetAllTargets = New Collection
    SetAllTargets.Add A
    SetAllTargets.Add B
End Function

Function SetInfo(Source As String, Destination As String) As CInfo
    Set SetInfo = New CInfo
    SetInfo.Source = Source
    SetInfo.Destination = Destination
End Function

Sub CopyValues(ByRef target As Variant)
    Range(target.Source).Select
    Selection.Copy
    Range(target.Destination).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
like image 134
Dick Kusleika Avatar answered Nov 20 '22 18:11

Dick Kusleika