Append One Array to Another, and Consolidate

[Alan Beban]

The fifth element is the monthly return of the stock with ticker "A", which
is the same in both cases, so it would still be 7 in the consolidated array.

I'm afraid I still don't see eactly what the "duplicate consolidation"
specs are, but if the functions in the freely downloadable file at
http://home.pacbell.net/beban are available to your workbook, the two
arrays can be combined in a new myArray1 with

i = UBound(myArray1)
j = UBound(myArray2)
k = UBound(myArray1, 2)
ResizeArray myArray1, i + j, k
ReplaceSubArray myArray1, myArray2, i + 1, 1

Alan Beban

 

[Stratuser]

Thanks, these array functions are very interesting, and I'll look into them.

 

[Albert]

If your still interested, I have developed a good algorithm to do exactly
what you want.
Regards,
Albert C.

 

[Alan Beban]

What do you mean by "consolidates the duplicate elements"?

Alan Beban

 

[Albert]

It means that duplicate registers will be deleted from the array.

 

[pb1]

I'm interested. Wonder if you can show your coding here.

 

[Albert]

Here goes. It uses a sort algorithm I got previously called QuickSort. I will
post it next.
Be careful with the comments I made. The initial apostrophes always get lost
in the copy paste procedure.
Regards
Albert C.

Public ConsolidatedArray() As Variant
Sub CallArrayConsolidator()

Dim ArrayTest1() As Variant
Dim ArrayTest2() As Variant

ArrayTest1 = Range("A1", "L35")
ArrayTest2 = Range("A20", "M42")
Call ArrayConsolidator(ArrayTest1, ArrayTest2)
Range("A50", "L100") = ConsolidatedArray

End Sub
Sub ArrayConsolidator(Array1, Array2)

' Alberto Cattan Rozenfarb
' (e-mail address removed)
' 17 de Noviembre de 2006

' Array1 y Array2 son dos arrays exógenos que pueden o no tener elementos
duplicados
' Array1 and Array2 are two exogenous arrays which may or may not have
duplicated registers
' Array1 = Range("A1", "L19")
' Array2 = Range("A20", "L42")
If Not UBound(Array1, 2) = UBound(Array2, 2) Then
MsgBox "La segunda dimensión de los dos arrays debe tener el mismo
UBound."
Exit Sub
End If

' Se crea Array3 que es una combinación de Array1 y Array2.
' Tiene 2 columnas extra para reconocer registros duplicados.
' We create Array3 which is a blunt combination of Array1 and Array2
' It has 2 extra columns which we will use to identify and eliminate
duplicates.
ReDim Array3(1 To UBound(Array1) + UBound(Array2), 1 To UBound(Array1,
2) + 2)
For x = 1 To UBound(Array1)
For Y = 1 To UBound(Array1, 2)
Array3(x, Y) = Array1(x, Y)
Next Y
Next x
For x = 1 To UBound(Array2)
For Y = 1 To UBound(Array1, 2)
Array3(UBound(Array1) + x, Y) = Array2(x, Y)
Next Y
Next x

' Se genera una columna con un Concatenado de todas las demás columnas.
' Esta es la llave para reconocer duplicados
' We generate a column which concatenates all the columns in arrays 1&2
' We will use this column to identify duplicates
For x = 1 To UBound(Array3)
For g = 1 To UBound(Array1, 2)
Array3(x, UBound(Array2, 2) + 1) = Array3(x, UBound(Array2, 2) +
1) & Array3(x, g)
Next g
Next x

' Se ordena la matriz por esta (pen-última) columna
' We sort the array with the concatenated column as key
Call QuickSort(Array3, UBound(Array3, 2) - 1, LBound(Array3),
UBound(Array3), True)

' En la última columna se marcan los registros repetidos
' In the last column we identify and mark duplicates
For x = 2 To UBound(Array3)
If Array3(x, UBound(Array3, 2) - 1) = Array3(x - 1, UBound(Array3,
2) - 1) Then
Array3(x, UBound(Array3, 2)) = "REPETIDO"
End If
Next x

' Se ordena la matriz por orden de registros repetidos y no repetidos.
' We sort the array with the DuplicateIdentify column as key
Call QuickSort(Array3, UBound(Array3, 2), LBound(Array3),
UBound(Array3), True)

' Se cuenta la cantidad de registros NO repetidos, que va a ser el ubound
de la matriz limpia de duplicados.
' We determine the amount of non-duplicates in order to ReDim the clean
array
x = 1
Do Until Array3(x, UBound(Array3, 2)) <> Empty Or x = UBound(Array3, 1)
x = x + 1
Loop

' Array4 es la matriz limpia de duplicados. En vista de que los duplicados
ya fueron excluídos, ya no se necesitan las dos columnas extras.
' Array4 is the duplicate-free array. Since the duplicates have been
identified and sent to the end, we no longer need the extra columns.
ReDim ConsolidatedArray(1 To x - 1, 1 To UBound(Array2, 2))
For x = 1 To UBound(ConsolidatedArray, 1)
For Y = 1 To UBound(ConsolidatedArray, 2)
ConsolidatedArray(x, Y) = Array3(x, Y)
Next Y
Next x

End Sub

 

[Albert]

Sub QuickSort(SortArray, col, L, R, bAscending)

'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a second dimension greater than 1 (or zero)
'Modified to sort on a specified column in a 2D array
'Modified to do Ascending or Descending
Dim i, j, x, Y, mm

i = L
j = R
x = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < x And i < R)
i = i + 1
Wend
While (x < SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) > x And i < R)
i = i + 1
Wend
While (x > SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)

End Sub

 

[Albert]

Ooops, made a little mistake in CallArrayConsolidator
sorry. Here it is corrected.

Sub CallArrayConsolidator()

Dim ArrayTest1() As Variant
Dim ArrayTest2() As Variant

ArrayTest1 = Range("A1", "L35")
ArrayTest2 = Range("A20", "L42")
Call ArrayConsolidator(ArrayTest1, ArrayTest2)
Range("A50", "L100") = ConsolidatedArray

End Sub

 

[pb1]

Thanks a lot, my friend.
Best regards!

Phil

 

[Albert]

You are welcome.
Your feedback will be greatly appreciated so I can improve the algorithm.
Albert

 

[Alan Beban]

You are welcome.
Your feedback will be greatly appreciated so I can improve the algorithm.
Albert

I ran the programs with ranges A13 and A57.

The first had
1 2 3 4
5 1 7 3
9 10 11 12

The second had
21 9 21 24
25 26 10 28
29 30 31 11

The resulting consolidated array was
29 30 31 11
5 1 7 3
9 10 11 12
1 2 3 4
21 9 23 24

As you can see, it ignored the 2nd row of the second array, and it did
not eliminate the duplicates.

If the functions in the freely downloadable file at
http://home.pacbell.net/beban are available to one's workbook one can get

1 2 3 4
5 7 9 10
11 12 21 23
24 25 26 28
29 30 31 0

with the following code (variables are not declared)

Sub abtest1()
arr1 = Range("A13")
arr2 = Range("A57")
iCols = UBound(arr1, 2)
arrU = ArrayUniques(MakeArray(arr1, arr2, 1))
k = ArrayCount(arrU)
If k / iCols = Int(k / iCols) Then
q = (k / iCols)
Else
q = Int(k / iCols) + 1
End If
ConsolidatedArray = ArrayReshape(arrU, q, iCols)
Range("A11").Resize(q, iCols).Value = ConsolidatedArray
End Sub

Alan Beban

 

[Albert]

You are right, my algorithm was flawed.
Here it is fixed.
Please tell me how it you find any more bugs.
Thx,
Albert

Sub ArrayConsolidator(Array1, Array2)

' Alberto Cattan Rozenfarb
' (e-mail address removed)
' 17 de Noviembre de 2006

' Array1 y Array2 son dos arrays exógenos que pueden o no tener elementos
duplicados
' Array1 and Array2 are two exogenous arrays which may or may not have
duplicated registers
' Array1 = Range("A1", "L19")
' Array2 = Range("A20", "L42")
If Not UBound(Array1, 2) = UBound(Array2, 2) Then
MsgBox "La segunda dimensión de los dos arrays debe tener el mismo
UBound." & vbCrLf & "The second dimension for both arrays must have the same
UBound."
Exit Sub
End If

' Se crea Array3 que es una combinación de Array1 y Array2.
' Tiene 2 columnas extra para reconocer registros duplicados.
' We create Array3 which is a blunt combination of Array1 and Array2
' It has 2 extra columns which we will use to identify and eliminate
duplicates.
ReDim Array3(1 To UBound(Array1) + UBound(Array2), 1 To UBound(Array1,
2) + 2)
For x = 1 To UBound(Array1)
For Y = 1 To UBound(Array1, 2)
Array3(x, Y) = Array1(x, Y)
Next Y
Next x
For x = 1 To UBound(Array2)
For Y = 1 To UBound(Array1, 2)
Array3(UBound(Array1) + x, Y) = Array2(x, Y)
Next Y
Next x

' Se genera una columna con un Concatenado de todas las demás columnas.
' Esta es la llave para reconocer duplicados
' We generate a column which concatenates all the columns in arrays 1&2
' We will use this column to identify duplicates
For x = 1 To UBound(Array3)
For g = 1 To UBound(Array1, 2)
Array3(x, UBound(Array2, 2) + 1) = Array3(x, UBound(Array2, 2) +
1) & Array3(x, g)
Next g
Next x

' Se ordena la matriz por esta (pen-última) columna
' We sort the array with the concatenated column as key
Call QuickSort(Array3, UBound(Array3, 2) - 1, LBound(Array3),
UBound(Array3), True)


' En la última columna se marcan los registros repetidos
' In the last column we identify and mark duplicates
For x = 2 To UBound(Array3)
If Array3(x, UBound(Array3, 2) - 1) = Array3(x - 1, UBound(Array3,
2) - 1) Then
Array3(x, UBound(Array3, 2)) = "REPETIDO"
End If
Next x

' Se ordena la matriz por orden de registros repetidos y no repetidos.
' We sort the array with the DuplicateIdentify column as key
Call QuickSort(Array3, UBound(Array3, 2), LBound(Array3),
UBound(Array3), True)

' Se cuenta la cantidad de registros NO repetidos, que va a ser el ubound
de la matriz limpia de duplicados.
' We determine the amount of non-duplicates in order to ReDim the clean
array
x = 1
Do Until Array3(x, UBound(Array3, 2)) <> Empty Or x = UBound(Array3, 1)
x = x + 1
Loop

' El UBound de ConsolidatedArray depende de que haya o no duplicados.
' ConsolidatedArray's UBound depends on wheather or not there are
duplicated registers.
Dim ThereAreDuplicates As Boolean
ThereAreDuplicates = False
If Not x = UBound(Array3, 1) Then
ThereAreDuplicates = True
ElseIf x = UBound(Array3, 1) Then
If Array3(UBound(Array3, 1), UBound(Array3, 2)) = "REPETIDO" Then
ThereAreDuplicates = True
End If
End If
' Array4 es la matriz limpia de duplicados. En vista de que los duplicados
ya fueron excluídos, ya no se necesitan las dos columnas extras.
' Array4 is the duplicate-free array. Since the duplicates have been
identified and sent to the end, we no longer need the extra columns.
If ThereAreDuplicates = True Then
ReDim ConsolidatedArray(1 To x - 1, 1 To UBound(Array2, 2))
ElseIf ThereAreDuplicates = False Then
ReDim ConsolidatedArray(1 To x, 1 To UBound(Array2, 2))
End If
For x = 1 To UBound(ConsolidatedArray, 1)
For Y = 1 To UBound(ConsolidatedArray, 2)
ConsolidatedArray(x, Y) = Array3(x, Y)
Next Y
Next x

End Sub

 

[Alan Beban]

What were the fixes? I don't want to have to go through the code line by
line.

Alan Beban

 

[Albert]

Sorry,
I meant:
Please tell me if you find any more bugs.
Albert C.

 

[Alan Beban]

Sorry,
I meant:
Please tell me if you find any more bugs.
Albert C.

Yes, I know. But I want you to tell me what changes you made so that I
don't have to search through line by line to find those changes.

Alan Beban

 

[Albert]

I replaced the very end with this:

' El UBound de ConsolidatedArray depende de que haya o no duplicados.
' ConsolidatedArray's UBound depends on wheather or not there are
duplicated registers.
Dim ThereAreDuplicates As Boolean
ThereAreDuplicates = False
If Not x = UBound(Array3, 1) Then
ThereAreDuplicates = True
ElseIf x = UBound(Array3, 1) Then
If Array3(UBound(Array3, 1), UBound(Array3, 2)) = "REPETIDO" Then
ThereAreDuplicates = True
End If
End If
' Array4 es la matriz limpia de duplicados. En vista de que los duplicados
ya fueron excluídos, ya no se necesitan las dos columnas extras.
' Array4 is the duplicate-free array. Since the duplicates have been
identified and sent to the end, we no longer need the extra columns.
If ThereAreDuplicates = True Then
ReDim ConsolidatedArray(1 To x - 1, 1 To UBound(Array2, 2))
ElseIf ThereAreDuplicates = False Then
ReDim ConsolidatedArray(1 To x, 1 To UBound(Array2, 2))
End If
For x = 1 To UBound(ConsolidatedArray, 1)
For Y = 1 To UBound(ConsolidatedArray, 2)
ConsolidatedArray(x, Y) = Array3(x, Y)
Next Y
Next x

End sub

 

[Albert]

I replaced some stuff at the end. You only have to go throught the last two
"paragraphs".

 

[Alan Beban]

What do you mean by "the very end"? Exactly which lines were replaced?

Alan Beban

 

[Albert]

Check out the final 5 lines of the procedure...
I replaced this (old):

ReDim ConsolidatedArray(1 To x - 1, 1 To UBound(Array2, 2))
For x = 1 To UBound(ConsolidatedArray, 1)
For Y = 1 To UBound(ConsolidatedArray, 2)
ConsolidatedArray(x, Y) = Array3(x, Y)
Next Y
Next x

with this (new):

Dim ThereAreDuplicates As Boolean
ThereAreDuplicates = False
If Not x = UBound(Array3, 1) Then
ThereAreDuplicates = True
ElseIf x = UBound(Array3, 1) Then
If Array3(UBound(Array3, 1), UBound(Array3, 2)) = "REPETIDO" Then
ThereAreDuplicates = True
End If
End If
If ThereAreDuplicates = True Then
ReDim ConsolidatedArray(1 To x - 1, 1 To UBound(Array2, 2))
ElseIf ThereAreDuplicates = False Then
ReDim ConsolidatedArray(1 To x, 1 To UBound(Array2, 2))
End If
For x = 1 To UBound(ConsolidatedArray, 1)
For Y = 1 To UBound(ConsolidatedArray, 2)
ConsolidatedArray(x, Y) = Array3(x, Y)
Next Y
Next x