View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Leo Heuser[_2_] Leo Heuser[_2_] is offline
external usenet poster
 
Posts: 111
Default Help with If Not Intersect

Sorry about the word-wrapping. Here's one
without:

Function ComplementaryRange(SuperRange As Range, _
SubRange As Range) As Range
'Leo Heuser, 11 July 2003
Dim ComplementRange As Range
Dim Counter As Long
Dim PartRange(1 To 4) As Range

On Error Resume Next

Set SubRange = Intersect(SuperRange, SubRange)
With SuperRange
Set PartRange(1) = Cells(.Row, .Column). _
Resize(SubRange.Row - .Row, .Columns.Count)

Set PartRange(2) = Cells(SubRange.Row, .Column). _
Resize(SubRange.Rows.Count, SubRange.Column - .Column)

Set PartRange(3) = Cells(SubRange.Row, SubRange.Column + _
SubRange.Columns.Count). _
Resize(SubRange.Rows.Count, .Columns.Count - _
(SubRange.Column - .Column + SubRange.Columns.Count))

Set PartRange(4) = Cells(SubRange.Row + _
SubRange.Rows.Count, .Column). _
Resize(.Rows.Count - (SubRange.Row - .Row + _
SubRange.Rows.Count), .Columns.Count)
End With

For Counter = 1 To 4
If Not PartRange(Counter) Is Nothing Then
If ComplementRange Is Nothing Then
Set ComplementRange = PartRange(Counter)
Else
Set ComplementRange = Union(ComplementRange, _
PartRange(Counter))
End If
End If
Next Counter

Set ComplementaryRange = ComplementRange
End Function