When an Array isn't an Array

[hatman]

So I have this custom Type:

Public Type Shape_Export_Data_Ver_1

    sedName As String
    sedText As String
    sedTop As Double
    sedLeft As Double
    sedWidth As Double
    sedHeight As Double
    sedShadow_Visible As Boolean
    sedShadow_Type As Integer
    sedType As Integer
    sedConnector_BeginShape As String
    sedConnector_EndShape As String
    sedConnector_BeginAnchor As Integer
    sedConnector_EndAnchor As Integer
    sedFont_Color As Integer
    sedFill_Color As Integer
    sedFont_Size As Integer
    sedConnector_Type As Integer
    sedGRIPS() As Double
    
End Type

But when I call the Join Function:

Dim Dat_Array() As Shape_Export_Data_Ver_1

...

Join(Dat_Array(Cnt).sedGRIPS, "|")

I get the following error:

Runtime Error 5: Invalid Procedure Call or Argument

While the Isarray() function

IsArray(Dat_Array(Cnt).sedGRIPS)

Returns a True.

So the work around is child's play... yet I'm a little troubled that the original usage doesn't work. Has anyone encountered this, or have some explanation. I assume that it's something to do with the the fact that I have defined an array as a custom type that contains an array, and the interpretter is just getting confused by the recursion...

 

[NateO]

Right, it's still an array, your problem is more fundamental than this, and I wasn't aware of this... It's that Join$() can't handle arrays that are of the Double data type.

Note the following:

Type myRecord
    strHouse As String
    lngRequired As Long
    boolOptional As Boolean
    varArr() As Variant
    dblArr() As Double
End Type
 
Sub foo()
Dim Records() As myRecord
ReDim Records(1 To 10)
Let Records(1).strHouse = "Roof"
Let Records(1).lngRequired = 100000
Let Records(1).boolOptional = False
Let Records(1).varArr = [{1,2,3}]
ReDim Records(1).dblArr(1 To 10)
Let Records(1).dblArr(1) = 1
Let Records(1).dblArr(2) = 5
Let Records(1).dblArr(3) = 10
 
Let Records(2).strHouse = "Floor"
Let Records(2).lngRequired = 2000
Let Records(2).boolOptional = True
Let Records(2).varArr = [{4,5,6}]
ReDim Records(2).dblArr(1 To 10)
Let Records(2).dblArr(1) = 100
Let Records(2).dblArr(2) = 500
Let Records(2).dblArr(3) = 1000
 
Debug.Print Join$(Records(1).varArr, "|"), _
    Join$(Records(2).varArr, "|")
 
Debug.Print Join$(Records(1).dblArr, "|"), _
    Join$(Records(2).dblArr, "|")
End Sub

Note that the Variant Array isn't a problem, but the Double Array bonks out. Is this due to the Custom Type? Nope, it fails under more oridinary circumstances as well:

Sub bar()
Dim dblArr() As Double
Dim i As Long
ReDim dblArr(1 To 10)
For i = LBound(dblArr) To UBound(dblArr)
    Let dblArr(i) = i ^ 2
Next
Debug.Print Join$(dblArr, "|")
End Sub

Join$() does work on String Arrays:

Sub baz()
Dim strArr() As String
Dim i As Long
ReDim strArr(1 To 10)
For i = LBound(strArr) To UBound(strArr)
    Let strArr(i) = i ^ 2
Next
Debug.Print Join$(strArr, "|")
End Sub

I can't find any documentation on the Double Type not being supported, but apparently it isn't.

You're right, the fix is trivial, use a Variant or String Array. The String Array might make most sense, seeing as you're creating a String via Join$().

Edit: Norie correctly pointed out a typo and a mistake I made about a comment and test procedure I had regarding Long-typed Arrays. I removed those to avoid confusion for future readers. Thanks, Norie.

 

[Norie]

Nate

Surely in your last test using Long the value is being coerced to a String since that's how you've typed the array.

Dim arr() As String
Dim I As Long
    ReDim arr(10)
    
    For I = 0 To 9
        arr(I) = I
    Next I
    
    MsgBox TypeName(arr(1))

 

[hatman]

Thanx Nate. That's good to know... it gives me more sensible options for getting around the bug (I hated doinn a For..Next loop to get around this).

The data for this array is actually being pulled from the Adjustments collection of a Shape Object, then written to a CSV file for later retrieval, re-split back into my custom type, and then passed back into the Adjustments collection of a newly generated Shape object... I would think that I could use any data type for teh Array, though now that I look more closely at the Adjustments collection, the data type is actually Single, not Double.

HEY! Do I get naming rights for this bug? I kinda like the sound of The Hatman Phenomena...

 

[NateO]

Nate

Surely in your last test using Long the value is being coerced to a String since that's how you've typed the array.

Yes, you're right. I wrote so much code, so quickly, I fooled myself. Long's not supported either. I better edit that as to not confuse people...

So, in limited tested, numeric Data Types not supported?

Nope, you can't name this a bug, Hatman. Microsoft will tell you that this behaviour is by design!

Use the Variant.

 

[Norie]

A bug?

How dare you?

Surely it's a much needed 'feature' utilized on a daily basis by thousands, nay millions, of Excel VBA users.

 

[Legacy 98055]

The data for this array is actually being pulled from the Adjustments collection of a Shape Object, then written to a CSV file for later retrieval, re-split back into my custom type, and then passed back into the Adjustments collection of a newly generated Shape object...

Just in passing. You can save/retrieve UDT's directly to/from disk using binary format. Is easier if you use fixed length strings but the method for variable len is easy. If you think it's worth the effort, reply and I'll cook up an example.

 

[hatman]

Just in passing. You can save/retrieve UDT's directly to/from disk using binary format. Is easier if you use fixed length strings but the method for variable len is easy. If you think it's worth the effort, reply and I'll cook up an example.

I have used Get and Put for fixed length UDT's only (and had a frustrating time working my way through the vast difference in using Len versus LenB).

My recollection of that project was that varying lengths were not worth the trouble, and had severe limitations anyway. I would be VERY interested in a method that has no restrictions on length. I have not re-visited this since Nate's last post (to clean up the code and implement some better practices) but this is the current business end of my file-save method:

    Open File_PathName For Output As #1
    
    Write #1, gVer, Current_Version
    
    For Cnt = 1 To UBound(Dat_Array, 1)
    
'        A = Join(Dat_Array(Cnt).sedGRIPS, "|")

'        A = IsArray(Dat_Array(Cnt).sedGRIPS)

        A = ""
        
        For Each item In Dat_Array(Cnt).sedGRIPS
        
            A = A & "|" & item
        
        Next item
        
        A = Right(A, Len(A) - 1)

        Write #1, Dat_Array(Cnt).sedConnector_BeginAnchor, _
        Dat_Array(Cnt).sedConnector_BeginShape, _
        Dat_Array(Cnt).sedConnector_EndAnchor, _
        Dat_Array(Cnt).sedConnector_EndShape, _
        Dat_Array(Cnt).sedConnector_Type, _
        Dat_Array(Cnt).sedFill_Color, _
        Dat_Array(Cnt).sedFill_Color, _
        Dat_Array(Cnt).sedFont_Color, _
        Dat_Array(Cnt).sedHeight, _
        Dat_Array(Cnt).sedLeft, _
        Dat_Array(Cnt).sedFont_Size, _
        Dat_Array(Cnt).sedName, _
        Dat_Array(Cnt).sedShadow_Type, _
        Dat_Array(Cnt).sedShadow_Visible, _
        Dat_Array(Cnt).sedText, _
        Dat_Array(Cnt).sedTop, _
        Dat_Array(Cnt).sedType, _
        Dat_Array(Cnt).sedWidth, _
        A
        
    Next Cnt
    
    Write #1, 0, "BTC", 0, "", 0, 0, 0, 0, 0, 0, 0, "", 0, False, "", 0, 0, 0, ""
    
    For Cnt = LBound(BTC_Data, 2) To UBound(BTC_Data, 2)
    
        Write #1, BTC_Data(1, Cnt), _
        BTC_Data(2, Cnt), _
        BTC_Data(3, Cnt), _
        BTC_Data(4, Cnt), _
        BTC_Data(5, Cnt), _
        BTC_Data(6, Cnt), _
        BTC_Data(7, Cnt), _
        BTC_Data(8, Cnt), _
        BTC_Data(9, Cnt), _
        BTC_Data(10, Cnt)
    
    Next Cnt
    
    Close #1

I would like to makE this more elegant, if possible... it's effrective, but admittedly cludgey.



I see that I repeated one of my items (sedFill_Color) twice in this... now how did I manage that?

 

[Legacy 98055]

This may not be more elegant, but it is likely much faster. BTW, you can save very large Excel ranges and restore them using a simple variant. Is very quick.

http://home.fuse.net/tstom/1592384.0611080808.zip

Saving an array is easy and is usually the way I would do it. If you must save various records that are a UDT, you will need to index each record. This is fairly simple.

Option Explicit
 
Public Type Shape_Export_Data_Ver_1
 
    sedName As String
    sedText As String
    sedTop As Double
    sedLeft As Double
    sedWidth As Double
    sedHeight As Double
    sedShadow_Visible As Boolean
    sedShadow_Type As Integer
    sedType As Integer
    sedConnector_BeginShape As String
    sedConnector_EndShape As String
    sedConnector_BeginAnchor As Integer
    sedConnector_EndAnchor As Integer
    sedFont_Color As Integer
    sedFill_Color As Integer
    sedFont_Size As Integer
    sedConnector_Type As Integer
    sedGRIPS() As Double
 
End Type
 
Dim Dat_Array() As Shape_Export_Data_Ver_1
 
Sub Example__SaveRestoreUDTArray()
    ChDir ThisWorkbook.Path
    BuildArray
    SaveArrayToFile
    Erase Dat_Array
    Stop
    RestoreArrayFromFile
    SendUDTArray2Range
    Erase Dat_Array
End Sub
 
Sub BuildArray()
    Dim x As Integer, y As Integer
 
    ReDim Dat_Array(10000)
 
    For x = 0 To 10000
        With Dat_Array(x)
            .sedName = "String" & x
            .sedText = "String" & x
            .sedTop = x
            .sedLeft = x
            .sedWidth = x
            .sedHeight = x
            .sedShadow_Visible = (1 And x)
            .sedShadow_Type = x
            .sedType = x
            .sedConnector_BeginShape = "String" & x
            .sedConnector_EndShape = "String" & x
            .sedConnector_BeginAnchor = x
            .sedConnector_EndAnchor = x
            .sedFont_Color = x
            .sedFill_Color = x
            .sedFont_Size = x
            .sedConnector_Type = x
            ReDim .sedGRIPS(10)
            For y = 0 To 10
                .sedGRIPS(y) = y
            Next
        End With
    Next
 
End Sub
 
Sub SaveArrayToFile()
    Dim FileNum As Integer, NumIndices As Double
 
    FileNum = FreeFile
    Open "Shape_Export_Data_Ver_1.bin" For Binary Access Write As #FileNum
        NumIndices = UBound(Dat_Array)
        Put #FileNum, 1, NumIndices
        Put #FileNum, 9, Dat_Array
    Close #FileNum
End Sub
 
Sub RestoreArrayFromFile()
    Dim FileNum As Integer, NumIndices As Double
 
    FileNum = FreeFile
    Open "Shape_Export_Data_Ver_1.bin" For Binary Access Read As #FileNum
        Get #FileNum, 1, NumIndices
        ReDim Dat_Array(NumIndices)
        Get #FileNum, 9, Dat_Array
    Close #FileNum
End Sub
 
Sub SendUDTArray2Range()
    Dim x As Integer, y As Integer, r(), s() As String
 
    ReDim r(1 To UBound(Dat_Array) + 1, 1 To 18)
 
    For x = 1 To UBound(Dat_Array) + 1
        With Dat_Array(x - 1)
            r(x, 1) = .sedName
            r(x, 2) = .sedText
            r(x, 3) = .sedTop
            r(x, 4) = .sedLeft
            r(x, 5) = .sedWidth
            r(x, 6) = .sedHeight
            r(x, 7) = .sedShadow_Visible
            r(x, 8) = .sedShadow_Type
            r(x, 9) = .sedType
            r(x, 10) = .sedConnector_BeginShape
            r(x, 11) = .sedConnector_EndShape
            r(x, 12) = .sedConnector_BeginAnchor
            r(x, 13) = .sedConnector_EndAnchor
            r(x, 14) = .sedFont_Color
            r(x, 15) = .sedFill_Color
            r(x, 16) = .sedFont_Size
            r(x, 17) = .sedConnector_Type
            ReDim s(UBound(.sedGRIPS))
            For y = LBound(.sedGRIPS) To UBound(.sedGRIPS)
                s(y) = CStr(.sedGRIPS(y))
            Next
            r(x, 18) = Join$(s, ",")
        End With
    Next
 
    Cells.Clear
    Cells(1).Resize(UBound(Dat_Array) + 1, 18).Value = r
    Columns("A:R").EntireColumn.AutoFit
End Sub

 

[hatman]

I'm swamped with all sorts of other work, right now, preventing me from actually playing with this. But at first glance, your example the resulting file contains only data in the format of the UDT. In my case, I actually have some data in the format of the UDT, and other data in a completely different format... can a file be split that way with this method, or do I need to make provision to have each data set in an identical format?