View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
DataFreakFromUtah DataFreakFromUtah is offline
external usenet poster
 
Posts: 36
Default Opposite of Intersect function - an example

Here's a couple more Intersect exclude range examples:


Sub IntersectRangeExcludeFromRange1Example()
'Example of how to exclude the intersect of two
'ranges(Range 1 & Range 2) from Range 1.
Dim Rng1, Rng2, ExcludeRange As Range
Dim NewRg, CurrCell, AntiRange As Range

On Error Resume Next
Set Rng1 = Application.InputBox( _
prompt:="Select 1st Range of Cells
to Evaluate", Type:=8)
Set Rng2 = Application.InputBox( _
prompt:="Select 2nd Range of Cells
to Evaluate", Type:=8)

Set ExcludeRange = Intersect(Rng1, Rng2)


For Each CurrCell In Rng1.Cells
If Intersect(CurrCell, ExcludeRange) Is Nothing Then
If NewRg Is Nothing Then
Set NewRg = CurrCell
Else
Set NewRg = Union(NewRg, CurrCell)
End If
End If
Next
Set AntiRange = NewRg
AntiRange.Select
End Sub




Sub IntersectRangeExcludeFromRange2Example()
'Example of how to exclude the intersect of two
'ranges(Range 1 & Range 2) from Range 2.
Dim Rng1, Rng2, ExcludeRange As Range
Dim NewRg, CurrCell, AntiRange As Range

On Error Resume Next
Set Rng1 = Application.InputBox( _
prompt:="Select 1st Range of Cells
to Evaluate", Type:=8)
Set Rng2 = Application.InputBox( _
prompt:="Select 2nd Range of Cells
to Evaluate", Type:=8)

Set ExcludeRange = Intersect(Rng1, Rng2)


For Each CurrCell In Rng2.Cells
If Intersect(CurrCell, ExcludeRange) Is Nothing Then
If NewRg Is Nothing Then
Set NewRg = CurrCell
Else
Set NewRg = Union(NewRg, CurrCell)
End If
End If
Next
Set AntiRange = NewRg
AntiRange.Select
End Sub