Compare and update arrays

[DAO]

I have a problem with comparing two arrays and the looping logic is
doing my head in! Can anyone help please?

I want to compare two arrrays and update the values in array 2 with the
new values from array 1. The order of array 2 should be maintained.
Therefore, any new elements in array 1 (not currently present in array
2) should be added to the end of array 2

For example:
Array1 = ("a,1", "b,1", "c,1")
Array2 = ("b,2", "a,2", "x,2")

Updated Array 2 after comparison with Array 1 should be ("b,1", "a,1",
"x,2", "c,1").
i.e. Where found, the first element remains 'as is'. If not already
found in Array2, then it is added. The value of the second element is
updated.

Here's the code I've been attempting to create...but it's not working
as it should...

Sub Wash()

iCount = 1
iRow = 1

Do While iRow <= UBound(Array1, 1)
'if elements in both arrays are equal then move on...
Do While Array1(iRow, 1) <> Array2(iCount, 1)
'but if not, then check if array2 is empty
If IsEmpty(Array2(iCount, 1)) = True Then
'if empty, then add the new element to array2
Array2(iCount, 1) = Array1(iRow, 1)
Array2(iCount, 2) = Array1(iRow, 2)
Exit Do
End If
'Otherwise, if the array is not empty, then increment the
' counter in array2
iCount = iCount + 1
' Loop back, checking each of the elements in array2 for a match
' with array1. If no match is found then the value
' is added to array2 as above
Loop
' Now if the compared elements match, then assign
' the other values to array2
Array2(iCount, 1) = Trim(Array1(iRow, 1))
Array2(iCount, 2) = Trim(Array1(iRow, 2))

'Now that the values have been assigned, move on to
' the next element in array1
iRow = iRow + 1
Loop

End Sub

Please help!

 

[Tom Ogilvy]

Do you define your arrays like this:

Array1 = ("a,1", "b,1", "c,1")
Array2 = ("b,2", "a,2", "x,2")


or are they really 2 dimensional?

 

[Dave Peterson]

Application.match will be able to find a match in an array.

match(string, array,0)
will return a number if there was a match and an error if no match.

If there is no exact match, then you could split that value into its
pieces--delimited by a comma.

Then you can use that first portion to see if there's a match with just that
piece:

match(substring&"*",array,0)
(number means there was a match. error means no match.)

The "option base 1" is very important to this code. Remember to include it.

Option Explicit
Option Base 1
Sub testme()

Dim Array1 As Variant
Dim Array2 As Variant
Dim res As Variant
Dim iCtr As Long
Dim CommaPos As Long

Array1 = Array("a,1", "b,1", "c,1")
Array2 = Array("b,2", "a,2", "x,2")

For iCtr = LBound(Array1) To UBound(Array2)
res = Application.Match(Array1(iCtr), Array2, 0)
If IsNumeric(res) Then
'found an exact match
'do nothing more
Else
CommaPos = InStr(1, Array1(iCtr), ",", vbTextCompare)
If CommaPos = 0 Then
MsgBox "No comma in: " & Array1(iCtr)
Else
res = Application.Match _
(Left(Array1(iCtr), CommaPos) & "*", Array2, 0)
If IsNumeric(res) Then
'found a partial match
'just update it with the other value in array1
Array2(res) = Array1(iCtr)
Else
'add it to the end of the array
ReDim Preserve Array2(LBound(Array2) To UBound(Array2) + 1)
Array2(UBound(Array2)) = Array1(iCtr)
End If
End If
End If
Next iCtr

For iCtr = LBound(Array2) To UBound(Array2)
Debug.Print iCtr & "--" & Array2(iCtr)
Next iCtr

End Sub

 

[Dave Peterson]

And you wouldn't even need to look for that complete match--since you'd just be
replacing one value with itself.

Option Explicit
Option Base 1
Sub testme()

Dim Array1 As Variant
Dim Array2 As Variant
Dim res As Variant
Dim iCtr As Long
Dim CommaPos As Long

Array1 = Array("a,1", "b,1", "c,1")
Array2 = Array("b,2", "a,2", "x,2")

For iCtr = LBound(Array1) To UBound(Array2)
CommaPos = InStr(1, Array1(iCtr), ",", vbTextCompare)
If CommaPos = 0 Then
MsgBox "No comma in: " & Array1(iCtr)
Else
res = Application.Match _
(Left(Array1(iCtr), CommaPos) & "*", Array2, 0)
If IsNumeric(res) Then
'found a partial match
'just update it with the other value in array1
Array2(res) = Array1(iCtr)
Else
ReDim Preserve Array2(LBound(Array2) To UBound(Array2) + 1)
Array2(UBound(Array2)) = Array1(iCtr)
End If
End If

Next iCtr

For iCtr = LBound(Array2) To UBound(Array2)
Debug.Print iCtr & "--" & Array2(iCtr)
Next iCtr
End Sub

 

[DAO]

Hi Tom,

Yes they are two dimensional. I guess I haven't declared them
correctly...
I meant for the arrays to have two dimensions (3x2) and the elements -
e.g. Array 1 -> (1,1) = "a"; (1,2) = "1"; (2,1) = "b" etc

 

[DAO]

Hi Tom,

Yea I guess I declared it incorrectly. They should be 2 dimensional
arrays (3x2). Elements (1,1) = "a", (1,2) = 1, (2,1) = "b" etc

 

[Tom Ogilvy]

A1:B3 held your Array2 values
C13 held your Array1 values

Added 3 blank cells to the range for Array2 so it had space for additions.

Sub Wash()

iCount = 1
iRow = 1
Array1 = Range("C13").Value
Array2 = Range("A1:B6").Value
Do While iRow <= UBound(Array1, 1)
'if elements in both arrays are equal then move on...
bAdded = False
Do While Trim(Array1(iRow, 1)) <> Trim(Array2(iCount, 1))
'but if not, then check if array2 is empty
If IsEmpty(Array2(iCount, 1)) = True Then
'if empty, then add the new element to array2
Array2(iCount, 1) = Trim(Array1(iRow, 1))
Array2(iCount, 2) = Trim(Array1(iRow, 2))
bAdded = True
Exit Do
End If
'Otherwise, if the array is not empty, then increment the
' counter in array2
iCount = iCount + 1
' Loop back, checking each of the elements in array2 for a match
' with array1. If no match is found then the value
' is added to array2 as above
Loop
' Now if the compared elements match, then assign
' the other values to array2
If Not bAdded Then
If Trim(Array2(iCount, 1)) = Trim(Array1(iRow, 1)) Then
Array2(iCount, 2) = Trim(Array1(iRow, 2))
End If
End If
'Now that the values have been assigned, move on to
' the next element in array1
iRow = iRow + 1
iCount = 1
Loop
Range("A10:B15").Value = Array2
End Sub

this produced the results you show.