join 2D array

I have problem. Any example tell me how to join 2D array ?

That RED Color , is wrong ?

Please!


Option Explicit

Private Sub Command1_Click()

List1.Clear


Dim AData() As String

'first; AData TOTAL '0 floor
'Function readA helpme to make building, each floor provide unit-A,unit-B
AData = readA(vbNullString, "-2", "3", "RED") '5 floor add
'now, AData() add 5 floor


If Text1.Text = "need" Then
'converge AData(), use Function readA
if need make new floor, read that 5 floor , and insert 3 floor
AData = readA(AData(), "-1", "2", "ORANGE") '3 floor add
End If

'=AData() Total 5+3=8 floor, total this building = 8 floor


'Result
Dim cm As Integer
For cm = LBound(AData) To UBound(AData)
List1.AddItem cm & ">" & AData(cm, 0) & ">" & AData(cm, 1) & ">" '& AData(cm, 2)
Next cm

End Sub '/cmd1

'////////////////////////////////////////////////////


Public Function readA(ByRef myArray() As Variant, ByVal FC_CarPark As String, ByVal FC_Roof As String, ByVal FC_TypeA As String) As Variant

Dim i As Integer
Dim N As Integer
Dim AData() As String

Dim total_floor As Double

total_floor = Val(FC_Roof) - Val(FC_CarPark)


ReDim Preserve AData(total_floor, 1)

N = 0

For i = Val(FC_CarPark) To Val(FC_Roof)
AData(N, 0) = FC_TypeA & "-unit-apple" & i
AData(N, 1) = FC_TypeA & "-unit-boy" & i
N = N + 1
Next i


readA = AData

End Function 'AData

Try this code


Function Array2dAppend(ByRef avValues As Variant, ByRef avAppendValues As Variant) As Long
Dim lNumNewCols As Long, lNumNewRows As Long
Dim lThisRecord As Long, lThisCol As Long
Dim lNumExistingRows As Long, lNumExistingCols As Long
Dim lOffset As Long

On Error GoTo ErrFailed
If IsArray(avAppendValues) Then
'Determine the size of the new array
lNumNewCols = UBound(avAppendValues)
lNumNewRows = UBound(avAppendValues, 2)

If IsArray(avValues) Then
'Resize result array to hold new values
lNumExistingRows = UBound(avValues, 2)
lOffset = (1 - LBound(avValues, 2))
ReDim Preserve avValues(LBound(avValues, 1) To UBound(avValues, 1), LBound(avValues, 2) To lNumExistingRows + lNumNewRows + lOffset)
Else
'Create result array
ReDim avValues(0 To lNumNewCols, 0 To lNumNewRows)
lOffset = 1
End If

lNumExistingCols = UBound(avValues, 1)
Array2dAppend = lNumExistingRows + lNumNewRows + 1

'Copy values into result array
For lThisRecord = LBound(avValues, 2) To lNumNewRows
For lThisCol = LBound(avValues, 1) To lNumExistingCols
avValues(lThisCol, lNumExistingRows + lThisRecord + lOffset) = avAppendValues(lThisCol, lThisRecord)
Next
Next
Else
'Return the number of elements in the existing array
Array2dAppend = UBound(avValues, 2)
End If

Exit Function

ErrFailed:
Debug.Print "Failed Array2dAppend: " & Err.Description
Array2dAppend = -1
End Function


Sub Test()
Dim asVals1() As Variant, asVals2() As Variant
Dim lThisVal As Long

ReDim asVals1(1 To 2, 1 To 5)
ReDim asVals2(1 To 2, 1 To 5)
'Create an array containing "A" to "E" in first col
'and 1 to 5 in second col
For lThisVal = 1 To 5
asVals1(1, lThisVal) = lThisVal
asVals1(2, lThisVal) = Chr(64 + lThisVal)
Next
'Create another array containing "F" to "J" in first col
'and 1 to 5 in second col
For lThisVal = 1 To 5
asVals2(1, lThisVal) = lThisVal + 5
asVals2(2, lThisVal) = Chr(64 + lThisVal + 5)
Next

'Add the contents of asVals2 to asVals1
Array2dAppend asVals1, asVals2

'Display the new values in asVals1
For lThisVal = 1 To 10
Debug.Print "Row " & lThisVal
Debug.Print asVals1(1, lThisVal)
Debug.Print asVals1(2, lThisVal)
Next
End Sub

Or now my problem,
Array details:

base:
0)X>x0=Y>y0
1)X>x1=Y>y1
2)X>x2=Y>y2

not sucess, hope return:
0)X>x0=Y>y0
1)X>x1=Y>y1
2)X>x2=Y>y2
3)X>a0=Y>b0 'insert,and return
4)X>a1=Y>b1
5)X>a2=Y>b2




Option Explicit


Private Sub Command1_Click()

Dim FC_array() As String


ReDim Preserve FC_array(2, 1)

FC_array(0, 0) = "x0"
FC_array(0, 1) = "y0"
FC_array(1, 0) = "x1"
FC_array(1, 1) = "y1"
FC_array(2, 0) = "x2"
FC_array(2, 1) = "y2"

Dim a As Variant

a = make_building(FC_array(), -2, 1, "red")


End Sub 'cmd1

'///////////////////


Public Function make_building(ByRef avValues As Variant, _
ByVal FC_carpark As Double, _
ByVal FC_roof As Double, _
ByVal FC_TypeA As String) As Variant


Dim cm As Integer
For cm = LBound(avValues) To UBound(avValues)
List1.AddItem cm & ")X>" & avValues(cm, 0) & "=Y>" & avValues(cm, 1) & ">"
Next cm



ReDim Preserve avValues(LBound(avValues, 1) To UBound(avValues, 1), _
LBound(avValues, 2) To (UBound(avValues, 2)))

ReDim avValues(LBound(avValues, 1) To UBound(avValues, 1) + 1, _
LBound(avValues, 2) To (UBound(avValues, 2) + 1) + (1 - LBound(avValues, 2)))



Dim N As Double
Dim i As Double

N = UBound(avValues)
For i = 0 To 2
avValues(N, 0) = "a" & i
avValues(N, 1) = "b" & i
N = N + 1
Next i



List1.AddItem "----"
Dim ct As Integer
For ct = LBound(avValues) To UBound(avValues)
List1.AddItem ct & "$)X>" & avValues(ct, 0) & "=Y>" & avValues(ct, 1) & ">"
Next ct



End Function