Compare two arrays and store matching items into new array

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Compare two arrays and store matching items into new array

Logged in as: Guest

arrSession:exec spGetSession 2,2,40686

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> WSH & Client Side VBScript >> Compare two arrays and store matching items into new array
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Compare two arrays and store matching items into new array - 12/10/2006 11:47:09 AM

mrmore

Posts: 5
Score: 0
Joined: 11/9/2006
Status: offline

Ive used this function to process large amounts of data. Hopefully someone else will also find it useful.
Compares array1 to array2 and the results are assigned to the function.

Option Explicit
Dim array1, array2, arrmatch, item
array1 = Array("item1", "item2", "item3", "item4", "item5", "item6", "item7", "item8", "item9", "item10")
array2 = Array("item4", "item5", "item6", "item7", "item8", "item9", "item3", "item11", "item12", "item13")
arrMatch = CompArrays(array1, array2)
If IsArray(arrMatch) then
For each item in arrMatch
MsgBox item
Next
Else
MsgBox arrMatch
End If

Private Function CompArrays(ByVal array1, array2)
Dim intMatching' as Integer
Dim arrItem1, arrItem2, arrMatch, i
Dim bolMatch' as Boolean
Dim strMatch' as String
intMatching = 0
If IsArray(array1) AND IsArray(array2) Then
' Count matching items to define array
For each arrItem1 in array1
bolMatch = 0
For each arrItem2 in array2
If UCase(arrItem1) = UCase(arrItem2) Then
  bolMatch = 1
  Exit For
End If
Next
If bolMatch = 1 Then
intMatching = intMatching + 1
End If
Next
If intMatching > 0 Then
ReDim arrMatch(intMatching - 1)
For each arrItem1 in array1
bolMatch = 0
For Each arrItem2 in array2
  If UCase(arrItem1) = UCase(arrItem2) Then
   bolMatch = 1
   Exit For
  End If
Next
If bolMatch = 1 Then
  For i = 0 to intMatching
   If VarType(arrMatch(i)) = 0 Then
    arrMatch(i) = arrItem1
    Exit For
   End If
  Next
End If
Next
Else
strMatch = "Failed: Matching items not found"
End If
Else
strMatch = "Failed: Input not an array"
End If
If InStr(1, strMatch, "Failed", 1) Then
CompArrays = strMatch
Else
CompArrays = arrMatch
End If
End Function

< Message edited by mrmore -- 12/10/2006 2:10:06 PM >

Post #: 1

RE: Compare two arrays and store matching items into ne... - 12/10/2006 9:01:07 PM

ehvbs

Posts: 2172
Score: 50
Joined: 6/22/2005
From: Germany
Status: online

Hi mrmore,

seeing your interest in "compare arrays", I'm wondering if you feel like
looking at

http://www.visualbasicscript.com/m_40495/tm.htm

where we (ashok_ganeshs, ehvbs, ebgreen, ...) face this very problem.
To spike your interest:

Dim aFrs, aSec, aMrg
   Dim nIdx
 
   aFrs = Array( "Phil", "Harry", "Fred", "Phil" )
   aSec = Array( "Phil", "Fred", "George" )
   aMrg = mergeArrays( aFrs, aSec )
 
   WScript.Echo "aFrs", Join( aFrs, " * " )
   WScript.Echo "aSec", Join( aSec, " * " )
 
   For nIdx = 0 To UBound( aMrg )
       WScript.Echo aMrg( nIdx, 0 ), aMrg( nIdx, 1 )
   Next
 
 Function mergeArrays( aFrs, aSec )
   Dim aRVal
   Dim dicFrs, dicSec, dicAll
   Dim aKeys
   Dim nIdx
   Dim sKey
 
   Set dicFrs = CreateObject( "Scripting.Dictionary" )
   Set dicSec = CreateObject( "Scripting.Dictionary" )
   Set dicAll = CreateObject( "Scripting.Dictionary" )
   For nIdx = 0 To UBound( aFrs )
       If Not dicFrs.Exists( aFrs( nIdx ) ) Then dicFrs.Add aFrs( nIdx ), ""
       If Not dicAll.Exists( aFrs( nIdx ) ) Then dicAll.Add aFrs( nIdx ), ""
   Next
   For nIdx = 0 To UBound( aSec )
       If Not dicSec.Exists( aSec( nIdx ) ) Then dicSec.Add aSec( nIdx ), ""
       If Not dicAll.Exists( aSec( nIdx ) ) Then dicAll.Add aSec( nIdx ), ""
   Next
   aKeys = dicAll.Keys
   ReDim aRVal( UBound( aKeys ), 1 )
   For nIdx = 0 To UBound( aKeys )
       sKey = aKeys( nIdx )
       If dicFrs.Exists( sKey ) Then aRVal( nIdx, 0 ) = sKey Else aRVal( nIdx, 0 ) = "---"
       If dicSec.Exists( sKey ) Then aRVal( nIdx, 1 ) = sKey Else aRVal( nIdx, 1 ) = "---"
   Next
   mergeArrays = aRVal
 End Function

(in reply to mrmore)