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
|