Solved: To Redim a two-dimensional dynamic array

[troelsi]

Hi I've created a little example to illustrate the problem that I'm facing.

Suppose I've the following data:
1 3 2
3 1
5 2
4
2


Now I would like to enter this data into a two-dimensional array. It would be very convenient if the array has as many indexes as elements. In the above data there is 9 elements of data therefore the array should have 9 indexes, if this was a one dimensional array it would be easy: dim array(1 to 9), but the second dimension in a two-dimensional array should illustrate the column.

I've tryed the following but without succes:


Option Base 1
Dim x(), O(3) As Integer
Dim i, j As Integer

Sub test()

For i = 1 To 3
For j = 1 To 5
If Cells(i, j) > 0 Then
O(i) = O(i) + 1
ReDim Preserve x(O(i), i)
x(O(i), i) = Cells(i, j)
End If
Next j
Next i
MsgBox ("numbers in column A: " & UBound(x, 1))
End Sub


The problem with the above code is: ReDim Preserve x(O(i), i), but I don't how to fix it. How do I redim my array in this example?

Your help would be appreciated.

Regards

Troels

[mikerickson]

ReDimensioning an array only works with the highest index.
Redim myArray(1 to 10, 1 to 10)
Redim myArray(1 to 10, 1 to 4):Rem this line does not error
Redim myArray(1 to 4, 1 to 10):Rem this line errors.
I'm not clear about the array size you want.
What is dimension should x have from the data shown?

[Bob Phillips]

How about an array of arrays



Dim x(), O() As Integer
Dim i, j As Integer

Sub test()

ReDim x(1 To 1)
For i = 1 To 5
ReDim O(1 To 1)
For j = 1 To 3
If Cells(i, j) > 0 Then
ReDim Preserve O(1 To j)
O(j) = Cells(i, j)
End If
Next j
ReDim Preserve x(1 To i)
x(i) = O
Next i
MsgBox ("numbers in column A: " & UBound(x, 1))
End Sub

[troelsi]

GREAT thanks a lot XLD.

It seems so obvious now that I know the solution.

Regards

Troelsi

[troelsi]

Unfortunately it doesn't seem to work with userdefined types:


Type xt
y As Integer
End Type

Dim x(), O() As xt
Dim i, j, k As Integer

Sub test()

ReDim x(1 To 1)
For j = 1 To 3
ReDim O(1 To 1)
For i = 1 To 5
If Cells(i, j) > 0 Then
ReDim Preserve O(1 To i)
O(i).y = Cells(i, j)
End If
Next i
ReDim Preserve x(1 To j)
x(j) = O
Next j
For j = 1 To UBound(x)
O = x(j)
For i = 1 To UBound(x(j))
Debug.Print O(i).y
Next i
Next j
End Sub



I would like to use userdefined type because I have several pieces of information related to every index in the array .

Any suggestions?

[Bob Phillips]

Create a class, as I said before UDTs are bad news.

[troelsi]

The thing is I don't know how to create a class.

Could you please show me how or do you know of any documents explaining how to create and use classes insted of types.

Thanks

[troelsi]

I finally managed to create a class and used it so solve this problem.
If anyone should be interestede here it is:


Sub test()
Dim x As New xts
Dim i, j, k As Integer
For i = 1 To 3
MsgBox x.count((i))
Next i
End Sub

'A Class Module named xt
Private my As Integer
Property Get y() As Integer
y = my
End Property
Property Let y(newvalue As Integer)
my = newvalue
End Property

'A Class Module named xts
Option Base 1
Private mxts(3) As Collection
Private Sub Class_Initialize()
Dim i, j, k As Integer
Dim objxt As xt
For j = 1 To 3
Set mxts(j) = New Collection
For i = 1 To 5
Set objxt = New xt
If Cells(i, j) > 0 Then
objxt.y = Cells(i, j)
mxts(j).Add objxt
End If
Next i
Next j
End Sub

Public Property Get count(j As Integer) As Long
count = mxts(j).count
End Property

[Bob Phillips]

No, that is not what I meant. I meant create a clss for the UDT, and use that in your code, like this.

First, create a simple class and call it xt with this code



Option Explicit

Private mcName As String
Private mcAge As Long
Private mcDate As Date

Public Property Let Name(ByVal Value As String)
mcName = Value
End Property
Public Property Get Name() As String
Name = mcName
End Property

Public Property Let Age(ByVal Value As Long)
mcAge = Age
End Property
Public Property Get Age() As Long
Age = mcAge
End Property

Public Property Let Entry(ByVal Value As Date)
mcDate = Value
End Property
Public Property Get Entry() As Date
Entry = mcDate
End Property


and then use like this



Dim x(), O() As xt
Dim i, j, k As Integer

Sub test()
Dim myUDT As xt

ReDim x(1 To 1)
For i = 1 To 5
ReDim O(1 To 1)
For j = 1 To 3
If Cells(i, j).Value > 0 Then
Set myUDT = New xt
ReDim Preserve O(1 To j)
myUDT.Name = "Name " & i & "-" & j
myUDT.Age = Cells(i, j).Value
myUDT.Entry = Date
Set O(j) = myUDT
End If
Next j
ReDim Preserve x(1 To i)
x(i) = O
Next i
For i = 1 To UBound(x)
For j = 1 To UBound(x(i))
Debug.Print x(i)(j).Name
Next j
Next i
End Sub