View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Compare and update arrays

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


DAO wrote:

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!


--

Dave Peterson