ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Compare 2 lists and show reconciliing items (https://www.excelbanter.com/excel-programming/376627-compare-2-lists-show-reconciliing-items.html)

MikeCM

Compare 2 lists and show reconciliing items
 
Is there any easy macro to look at a range of values (numbers) in a
column on one worksheet, look up a range of values in a column in
another worksheet, and (a) paste into another worksheet the values that
appear in the first but not the latter, and (b) that pastes in another
worksheet the values that are common to both? Thanks for any
suggestions.


Tom Ogilvy

Compare 2 lists and show reconciliing items
 
If by easy you mean someone else has already written it, then see this code
by KeepItKool

http://groups.google.com/group/micro...e=source&hl=en

Try following.


It's a general routine that's very fast and convenient
(the input arrays must contain unique ID's.)


Be aware that the returned arrays are 0 based.
ubound = -1 when empty.


Sub DemoMatchCols()
Dim vMatches
vMatches = ArrayMatcher(Range("a:a"), Range("b:b"))


If UBound(vMatches(0)) -1 Then
Range("d1").Resize(1 + UBound(vMatches(0))) = _
Application.Transpose(vMatches(0))
End If
If UBound(vMatches(1)) -1 Then
Range("e1").Resize(1 + UBound(vMatches(1))) = _
Application.Transpose(vMatches(1))
End If
If UBound(vMatches(2)) -1 Then
Range("f1").Resize(1 + UBound(vMatches(2))) = _
Application.Transpose(vMatches(2))
End If
End Sub


Function ArrayMatcher(ByVal List1 As Variant, _
ByVal List2 As Variant, _
Optional bIgnoreCase As Boolean = True)
'compares the values from 2 arrays
'and returns an array of 3 arrays of
'unique items(items left, items both, items right)
'
'author keepITcool excel.programming aug 9th,2005


'requires a reference to Microsoft Scripting Runtime
Dim dic(3) As Scripting.Dictionary
Dim itm, key, res
Dim i As Integer


For i = 0 To 3
Set dic(i) = New Dictionary
dic(i).CompareMode = IIf(bIgnoreCase, TextCompare, BinaryCompare)
Next


If Not IsArray(List1) Then Exit Function
If Not IsArray(List2) Then Exit Function
If Not IsArray(List1) Then Exit Function
If Not IsArray(List2) Then Exit Function
If TypeName(List1) = "Range" Then List1 = _
Intersect(List2.Parent.UsedRange, List1).Value
If TypeName(List2) = "Range" Then List2 = _
Intersect(List2.Parent.UsedRange, List2).Value


On Error Resume Next
'loop List1 and add all unique items to dic(3)
'dic(3) will be discarded later
For Each itm In List1
dic(3).Add CStr(itm), itm
Next


'loop List2:
'If found in dic(3) then add to dic(1) else add to dic(2)
For Each itm In List2
If dic(3).Exists(CStr(itm)) Then
dic(1).Add CStr(itm), itm
Else
dic(2).Add CStr(itm), itm
End If
Next


'loop dic(3):
'if not found add to dic(0)
For Each key In dic(3)
If Not dic(2).Exists(key) Then
dic(0).Add key, dic(3)(key)
End If
Next
Set dic(3) = Nothing
dic(2).Remove (vbNullString)
dic(1).Remove (vbNullString)
dic(0).Remove (vbNullString)


ReDim res(2)
res(0) = dic(0).Items
res(1) = dic(1).Items
res(2) = dic(2).Items
ArrayMatcher = res


End Function


--
keepITcool


--
Regards,
Tom Ogilvy


"MikeCM" wrote:

Is there any easy macro to look at a range of values (numbers) in a
column on one worksheet, look up a range of values in a column in
another worksheet, and (a) paste into another worksheet the values that
appear in the first but not the latter, and (b) that pastes in another
worksheet the values that are common to both? Thanks for any
suggestions.



MikeCM

Compare 2 lists and show reconciliing items
 
Tom - thanks for this... I will need to take a bit of time to go
through this and understand it for myself. Thanks so much for your
help.

Mike

Tom Ogilvy wrote:
If by easy you mean someone else has already written it, then see this code
by KeepItKool

http://groups.google.com/group/micro...e=source&hl=en

Try following.


It's a general routine that's very fast and convenient
(the input arrays must contain unique ID's.)


Be aware that the returned arrays are 0 based.
ubound = -1 when empty.


Sub DemoMatchCols()
Dim vMatches
vMatches = ArrayMatcher(Range("a:a"), Range("b:b"))


If UBound(vMatches(0)) -1 Then
Range("d1").Resize(1 + UBound(vMatches(0))) = _
Application.Transpose(vMatches(0))
End If
If UBound(vMatches(1)) -1 Then
Range("e1").Resize(1 + UBound(vMatches(1))) = _
Application.Transpose(vMatches(1))
End If
If UBound(vMatches(2)) -1 Then
Range("f1").Resize(1 + UBound(vMatches(2))) = _
Application.Transpose(vMatches(2))
End If
End Sub


Function ArrayMatcher(ByVal List1 As Variant, _
ByVal List2 As Variant, _
Optional bIgnoreCase As Boolean = True)
'compares the values from 2 arrays
'and returns an array of 3 arrays of
'unique items(items left, items both, items right)
'
'author keepITcool excel.programming aug 9th,2005


'requires a reference to Microsoft Scripting Runtime
Dim dic(3) As Scripting.Dictionary
Dim itm, key, res
Dim i As Integer


For i = 0 To 3
Set dic(i) = New Dictionary
dic(i).CompareMode = IIf(bIgnoreCase, TextCompare, BinaryCompare)
Next


If Not IsArray(List1) Then Exit Function
If Not IsArray(List2) Then Exit Function
If Not IsArray(List1) Then Exit Function
If Not IsArray(List2) Then Exit Function
If TypeName(List1) = "Range" Then List1 = _
Intersect(List2.Parent.UsedRange, List1).Value
If TypeName(List2) = "Range" Then List2 = _
Intersect(List2.Parent.UsedRange, List2).Value


On Error Resume Next
'loop List1 and add all unique items to dic(3)
'dic(3) will be discarded later
For Each itm In List1
dic(3).Add CStr(itm), itm
Next


'loop List2:
'If found in dic(3) then add to dic(1) else add to dic(2)
For Each itm In List2
If dic(3).Exists(CStr(itm)) Then
dic(1).Add CStr(itm), itm
Else
dic(2).Add CStr(itm), itm
End If
Next


'loop dic(3):
'if not found add to dic(0)
For Each key In dic(3)
If Not dic(2).Exists(key) Then
dic(0).Add key, dic(3)(key)
End If
Next
Set dic(3) = Nothing
dic(2).Remove (vbNullString)
dic(1).Remove (vbNullString)
dic(0).Remove (vbNullString)


ReDim res(2)
res(0) = dic(0).Items
res(1) = dic(1).Items
res(2) = dic(2).Items
ArrayMatcher = res


End Function


--
keepITcool


--
Regards,
Tom Ogilvy


"MikeCM" wrote:

Is there any easy macro to look at a range of values (numbers) in a
column on one worksheet, look up a range of values in a column in
another worksheet, and (a) paste into another worksheet the values that
appear in the first but not the latter, and (b) that pastes in another
worksheet the values that are common to both? Thanks for any
suggestions.





All times are GMT +1. The time now is 07:18 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com