Results 1 to 10 of 10

Thread: VBA EXCEL: How to sort an ArrayList that contains a class object?

Hybrid View

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    May 2005
    Posts
    431

    VBA EXCEL: How to sort an ArrayList that contains a class object?

    My class module called 'Tree':
    Code:
    Public a As Integer
    Public b As String
    My code
    Code:
        Set a = CreateObject("System.Collections.ArrayList")
        
        Dim myTree1 As Tree
        Set myTree1 = New Tree
        myTree1.a = 4534
        myTree1.b = "dfg"
        
        Dim myTree2 As Tree
        Set myTree2 = New Tree
        myTree2.a = 2
        myTree2.b = "my second tree"
        
        a.Add myTree1
        a.Add myTree2
        
        a.Sort
    This causes sort() to crash. Is it possible to tell the sort method to use the public attribute 'a' as its sorting number? I have found code to make this work in vb.net and java, but not vba.

    edit: Oops, posted in VB6 and not VBA section.

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    Set a = CreateObject("System.Collections.ArrayList")
    this does not look valid in vb6 or vba

    edit to set a default value in a class
    Creating A Default Member In VBA

    VBA does not directly support the creation of a default member of a class. That is, there is nothing in the VBA IDE that allows you to specify a default member. However, VBA does respect the default method if it is specified in a class. To specify a method as the default member, you need to Export the class module to a text file, edit that text file in NotePad or your favorite text editor, add an Attribute directive to the method, and then Import the text file back into the VBA Project.

    First, export the class module to a text file. In VBA, go to the File menu and choose Export File.... In the Save dialog that appears, navigate to some folder (it doesn't matter which folder), and save the class file as text with a cls extension. Next, select Remove... from the File menu and choose No in the Do you want to export? dialog. Next, open Notepad ( C:\Windows\Notepad.exe) or another text editor, and open the cls that you saved in the Export step. In the text file, go to the method that you want to make the default, and add the following line of code.

    Attribute Value.VB_UserMemId = 0

    An Attribute directive is an instruction to the compiler indicating various conditions for compilation. The Attribute directives are not visible in the VBA Editor and they cannot be added by the VBA Editor. You must use a text editor to add Attribute directives. If you are making the Value property the default member of your class, your code in Notepad should look similar to the following:

    Property Get Value() As Long
    Attribute Value.VB_UserMemId = 0
    Value = Whatever
    End Property

    You can make a Sub, Function, or Property the default member of the class, but only one procedure in the module may be the default member. Once you have added the Attribute directive to the text file, save the file and exit from NotePad. Now, in the VBA Editor, go to the File menu and choose Import File.... In the Open dialog that appears, navigate to the folder in which you saved the cls file and import it into VBA. Because Attribute directives are not visible in the VBA Editor, you will not see any changes in your code.
    from http://www.cpearson.com/excel/DefaultMember.aspx
    Last edited by westconn1; Apr 6th, 2019 at 05:43 AM.
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    Quote Originally Posted by westconn1 View Post
    this does not look valid in vb6 or vba
    . . . but it works.

    Why would you use .Net Framework to sort an array of COM objects is beyond comprehension though. . .

    cheers,
    </wqw>

  4. #4
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    Of course, every VB developer uses recordsets to sort almost anything, so. . . here you have it.

    A generic SortByObjectProperty function that works on normal (non-.Net) arrays:

    thinBasic Code:
    1. Option Explicit
    2.  
    3. Private Sub Form_Load()
    4.     Dim aIn(0 To 1) As Tree
    5.     Dim aOut()      As Tree
    6.    
    7.     Set aIn(0) = New Tree
    8.     aIn(0).a = 123
    9.     Set aIn(1) = New Tree
    10.     aIn(1).a = 23
    11.     aOut = SortByObjectProperty(aIn, "a", vbInteger)
    12.     Debug.Print aOut(0).a
    13.     Debug.Print aOut(1).a
    14. End Sub
    15.  
    16. Public Function SortByObjectProperty(aInput As Variant, PropName As String, Optional PropType As VbVarType) As Variant
    17.     Const adInteger As Long = 3
    18.     Const adVarWChar As Long = 202
    19.     Dim rs          As Object
    20.     Dim vElem       As Variant
    21.     Dim aOutput()   As Object
    22.     Dim lIdx        As Long
    23.    
    24.     Set rs = CreateObject("ADODB.Recordset")
    25.     rs.Fields.Append "Idx", adInteger
    26.     Select Case PropType
    27.     Case 0, vbString
    28.         rs.Fields.Append "Key", adVarWChar, 1000
    29.     Case vbByte, vbInteger, vbLong
    30.         rs.Fields.Append "Key", adInteger
    31.     Case Else
    32.         Err.Raise vbObjectError, , "Unsupported type: " & PropType
    33.     End Select
    34.     rs.Open
    35.     For Each vElem In aInput
    36.         rs.AddNew Array(0, 1), Array(lIdx, CallByName(vElem, PropName, VbGet Or VbMethod))
    37.         lIdx = lIdx + 1
    38.     Next
    39.     rs.Sort = "Key"
    40.     If rs.RecordCount > 0 Then
    41.         ReDim aOutput(0 To rs.RecordCount - 1) As Object
    42.         lIdx = 0
    43.         Do While Not rs.EOF
    44.             Set aOutput(lIdx) = aInput(rs.Fields("Idx").Value)
    45.             rs.MoveNext
    46.             lIdx = lIdx + 1
    47.         Loop
    48.     End If
    49.     SortByObjectProperty = aOutput
    50. End Function
    cheers,
    </wqw>

  5. #5
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    . . . but it works.
    must only be in latest versions of excel, as i did test in excel 2013 (newest i have)
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  6. #6
    Addicted Member gilman's Avatar
    Join Date
    Jan 2017
    Location
    Bilbao
    Posts
    176

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    Quote Originally Posted by westconn1 View Post
    must only be in latest versions of excel, as i did test in excel 2013 (newest i have)
    I try this code
    Code:
    Private Sub Macro()
        Dim x As Object
        Set x = CreateObject("System.Collections.ArrayList")
        x.Add "c"
        x.Add "b"
        x.Add "a"
        Dim r As Variant
        x.Sort
        For Each r In x
            Debug.Print (r)
        Next
     
    End Sub
    In Excel 2002, the oldest I have, and works fine.
    The problem is that the objects added to the ArrayList must implements System.IComparable and think that is not possible to do in VBA, and, if this is possible, how to do.

  7. #7
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    @westconn1: Can you add a typelib reference to C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb or under any other version of the .Net Framework?

    The typelib is a very instructive read I just discovered. The interfaces are worth studying, how they designed the whole thing at MS.

    Btw, it's safe to Implement IWhateverInterface in a class/form/control from this typelib as this will *not* require .Net on end-user machine in any way.

    cheers,
    </wqw>

  8. #8
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    One can stay in the realms of COM, e.g. with the ArrayList-Implementation of vbRichClient5,
    which supports to pass an (optional) CallBack-Object in its cArrayList.Sort Method:

    The Tree-Class in this example was defined this way:
    Code:
    Option Explicit
    
    Public L As Long
    Public S As String
    And the userdefined IComparer-CallBack will sort by L-Prop first ... and S-Prop second.
    Code:
    Option Explicit
    
    Implements IComparer
    
    Private Sub Form_Load()
      Dim AL As cArrayList, T As Tree, i As Long
      Set AL = New_c.ArrayList(vbObject) 'create an ArrayList-instance, which takes-up Objects
      
      'add 3 new Tree instances (with different content) to the ArrayList
      Set T = New Tree: T.L = 5: T.S = "c":   AL.Add T
      Set T = New Tree: T.L = 2: T.S = "a":   AL.Add T
      Set T = New Tree: T.L = 2: T.S = "b":   AL.Add T
      
      For i = 0 To AL.Count - 1: Debug.Print AL(i).L, AL(i).S: Next 'content before sorting
      Debug.Print String(16, "-")
      
      AL.Sort , , Me '<- userdefined sorting requires to pass an Object, which implements the Compare-Callback
      
      For i = 0 To AL.Count - 1: Debug.Print AL(i).L, AL(i).S: Next 'content after sorting
      Debug.Print String(16, "-")
    End Sub
    
    'First Sort by the L ... and then by the S-Property (in case L-Props were equal)
    Private Function IComparer_Compare(A As Variant, B As Variant) As Long
      IComparer_Compare = Sgn(A.L - B.L)
      If IComparer_Compare = 0 Then IComparer_Compare = StrComp(A.S, B.S, vbTextCompare)
    End Function
    
    Private Sub IComparer_TypeCheck(ByVal CurrentVarType As VbVarType, Example As Variant)
      'this second interface-callback-routine is not needed/used in this example
    End Sub
    HTH

    Olaf

  9. #9
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    @wqweto
    Can you add a typelib reference to C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb or under any other version of the .Net Framework?
    yes but i still could not access the collections of system, so i must be doing something wrong
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  10. #10
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: VBA EXCEL: How to sort an ArrayList that contains a class object?

    createobject fails for me in both excel 2013 and excel 2000
    i did not expect it to work in the 2000 as that machine does not have framework installed at all, but the 2013 is in w10, so i thought it might work there
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width