How find elements NOT common to two ranges?

[Chet]

Can someone help me with some code to give me the elements of two
ranges which are the NOT common to both ranges. In other words rngA
is blue white red, and rngB is blue white yellow. The outcome of the
code would give the two elements which are not in common to the two
ranges (red, yellow) since blue and white are in both ranges.

Thanks, Chet

 

[Bernie Deitrick]

Chet,

Sub FindUniqueElements()
Dim myC As Range
Dim rngA As Range
Dim rngB As Range
Dim myVals() As Variant
Dim myCount As Integer
Dim Msg As String

Set rngA = Range("A1:A3")
Set rngB = Range("B1:B3")
myCount = 0
For Each myC In rngA
If IsError(Application.Match(myC, rngB, False)) Then
myCount = myCount + 1
ReDim Preserve myVals(1 To myCount)
myVals(myCount) = myC.Value
End If
Next myC

For Each myC In rngB
If IsError(Application.Match(myC, rngA, False)) Then
myCount = myCount + 1
ReDim Preserve myVals(1 To myCount)
myVals(myCount) = myC.Value
End If
Next myC

Msg = ""

For myCount = 1 To UBound(myVals)
Msg = Msg & myVals(myCount) & Chr(10)
Next myCount

MsgBox Msg
End Sub


HTH,
Bernie
MS Excel MVP

 

[Chet]

Chet,

Sub FindUniqueElements()
Dim myC As Range
Dim rngA As Range
Dim rngB As Range
Dim myVals() As Variant
Dim myCount As Integer
Dim Msg As String

Set rngA = Range("A1:A3")
Set rngB = Range("B1:B3")
myCount = 0
For Each myC In rngA
If IsError(Application.Match(myC, rngB, False)) Then
myCount = myCount + 1
ReDim Preserve myVals(1 To myCount)
myVals(myCount) = myC.Value
End If
Next myC

For Each myC In rngB
If IsError(Application.Match(myC, rngA, False)) Then
myCount = myCount + 1
ReDim Preserve myVals(1 To myCount)
myVals(myCount) = myC.Value
End If
Next myC

Msg = ""

For myCount = 1 To UBound(myVals)
Msg = Msg & myVals(myCount) & Chr(10)
Next myCount

MsgBox Msg
End Sub

HTH,
Bernie
MS Excel MVP







- Show quoted text -

Wow Bernie I am awstruck!.... might you have time to give me a brief
explanation of how this works? I think it would help me concpetually
figure out what you did here. If not - no worries...

 

[ryguy7272]

Here is a function:
=IF(ISERROR(MATCH(A1:A6,B1:B6,0)),A1:A6,"")

Hit Ctrl+Shift+Enter, not just Enter.

Here is a VBA solution:
Sub checkrev()

With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh1Range = .Range("A1:A" & Sh1LastRow)
End With
With Sheets("Sheet1")
Sh2LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Set Sh2Range = .Range("B1:B" & Sh2LastRow)
End With

'compare Col 1 with Col 2
For Each Sh1cell In Sh1Range
Set c = Sh2Range.Find( _
what:=Sh1cell, LookIn:=xlValues)
If c Is Nothing Then
Sh1cell.Interior.ColorIndex = 3
Sh1cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh1cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh1cell.Interior.ColorIndex = 6
Sh1cell.Offset(0, 1).Interior.ColorIndex = xlNone
End If
End If
Next Sh1cell
'compare Col 2 with Col 1
For Each Sh2cell In Sh2Range
Set c = Sh1Range.Find( _
what:=Sh2cell, LookIn:=xlValues)
If c Is Nothing Then
Sh2cell.Interior.ColorIndex = 3
Sh2cell.Offset(0, 1).Interior.ColorIndex = xlNone
Else
If Sh2cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh2cell.Interior.ColorIndex = 6
Sh2cell.Offset(0, 1).Interior.ColorIndex = xlNone
End If
End If
Next Sh2cell

End Sub

HTH,
Ryan---

 

[Chet]

Here is a function:
=IF(ISERROR(MATCH(A1:A6,B1:B6,0)),A1:A6,"")

Hit Ctrl+Shift+Enter, not just Enter.

Here is a VBA solution:
Sub checkrev()

With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh1Range = .Range("A1:A" & Sh1LastRow)
End With
With Sheets("Sheet1")
Sh2LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Set Sh2Range = .Range("B1:B" & Sh2LastRow)
End With

'compare Col 1 with Col 2
For Each Sh1cell In Sh1Range
Set c = Sh2Range.Find( _
what:=Sh1cell, LookIn:=xlValues)
If c Is Nothing Then
Sh1cell.Interior.ColorIndex = 3
Sh1cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh1cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh1cell.Interior.ColorIndex = 6
Sh1cell.Offset(0, 1).Interior.ColorIndex = xlNone
End If
End If
Next Sh1cell
'compare Col 2 with Col 1
For Each Sh2cell In Sh2Range
Set c = Sh1Range.Find( _
what:=Sh2cell, LookIn:=xlValues)
If c Is Nothing Then
Sh2cell.Interior.ColorIndex = 3
Sh2cell.Offset(0, 1).Interior.ColorIndex = xlNone
Else
If Sh2cell.Offset(0, 1) <> c.Offset(0, 1) Then
Sh2cell.Interior.ColorIndex = 6
Sh2cell.Offset(0, 1).Interior.ColorIndex = xlNone
End If
End If
Next Sh2cell

End Sub

HTH,
Ryan---
--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''..













- Show quoted text -

Thanks much both.. I liked Bernie's solution a bit better since it was
cleaner and less code... Thx both though!.. I think I can learn
from this ..

 

[Dana DeLouis]

Can someone help me with some code to give me the elements of two
ranges which are the NOT common to both ranges. In other words rngA
is blue white red, and rngB is blue white yellow. The outcome of the
code would give the two elements which are not in common to the two
ranges (red, yellow) since blue and white are in both ranges.

Thanks, Chet

Hi. Here's some watered-down code I have. Maybe this will give you
some different ideas to explore.


Sub YourCode()
Dim Answer
Answer = SymmetricDifference([A1:A3], [B1:B3])
End Sub


'// Functions you will need...

Function SymmetricDifference(Rng1, Rng2)
SymmetricDifference = UnsortedUnion(Complement(Rng1, Rng2), _
Complement(Rng2, Rng1))
End Function


Function Complement(Rng1, Rng2)
'// Elements in Rng1 that are not in Rng2
'// By: Dana DeLouis

Dim D
Dim C As Range

Set D = CreateObject("Scripting.Dictionary")
For Each C In Rng1.Cells
If C <> vbNullString Then D.Add C.Value, 1
Next C

For Each C In Rng2.Cells
If D.Exists(C.Value) Then D.Remove (C.Value)
Next C

Complement = D.Keys
End Function


Function UnsortedUnion(M1, M2)
Dim D
Dim J As Long

Set D = CreateObject("Scripting.Dictionary")
For J = LBound(M1) To UBound(M1)
D.Add M1(J), 1
Next J

For J = LBound(M2) To UBound(M2)
D.Add M2(J), 1
Next J

UnsortedUnion = D.Keys
End Function


= = =
HTH :>)
Dana DeLouis

 

[Dana DeLouis]

Oops! I deleted too much.
I added the "On error" back here.

Function Complement(Rng1, Rng2)
'// Elements in Rng1 that are not in Rng2

Dim D
Dim C As Range

Set D = CreateObject("Scripting.Dictionary")
On Error Resume Next

For Each C In Rng1.Cells
If C <> vbNullString Then D.Add C.Value, 1
Next C

For Each C In Rng2.Cells
If D.exists(C.Value) Then D.Remove (C.Value)
Next C

Complement = D.keys
End Function



= = =
Dana DeLouis

<snip>