Hi..

this one's for the experts/mathematicians amongst us..
(Harlan, you reading this ? :)


does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give a
"LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

My theory (and bit of practice too:)

First get the 'outside range' sized from topleft to bottom right cell
of the multiarea.. that's done. (be carefull of unordered areas.)

Then create an array of same dimensions... and mark off the selected
cells. much faster then checking intersect during a 'normal' loop.

But then..? I need an efficient routine to create a a new range object
from that array... Since you want to avoid just dumping every TRUE in
the array in a union and let excel figure it out..

SO probably I need a 'mazing' algorithm but there I'm stuck for the
moment..and I'm pretty sure there must be some nice routines out there!


anyone?..

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

I haven't seen any and this apparently been discussed in detail on compuserv
several years ago. My suggestion, although kludgy, was to use a dummy
worksheet, fill the union with constants, clear the intersection, then use
specialcells with the union to return the inverse.

--
Regards,
Tom Ogilvy

"keepITcool" wrote in message
...

Hi..

this one's for the experts/mathematicians amongst us..
(Harlan, you reading this ? :)


does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give a
"LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

My theory (and bit of practice too:)

First get the 'outside range' sized from topleft to bottom right cell
of the multiarea.. that's done. (be carefull of unordered areas.)

Then create an array of same dimensions... and mark off the selected
cells. much faster then checking intersect during a 'normal' loop.

But then..? I need an efficient routine to create a a new range object
from that array... Since you want to avoid just dumping every TRUE in
the array in a union and let excel figure it out..

SO probably I need a 'mazing' algorithm but there I'm stuck for the
moment..and I'm pretty sure there must be some nice routines out there!


anyone?..

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

I'd thought about that, but find it too kludgy.
(then again.. i'll compromise my principles for speed..
IF nobody comes with a neater approach..

I hate using temp sheets in an existing book
as the sheet counts gets upped... same reason why
i dont really like 'on the fly' workbooks


Anybody else?... still open for suggestions :)




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Tom Ogilvy wrote :

I haven't seen any and this apparently been discussed in detail on
compuserv several years ago. My suggestion, although kludgy, was to
use a dummy worksheet, fill the union with constants, clear the
intersection, then use specialcells with the union to return the
inverse.

Hi KeepItCool,

You can see the conversation to which Tom alludes at :

http://tinyurl.com/5yyl4

Stealing acombination of these ideas, I use the following function which, in
my timings, is significantly faster than loop approaches that i tried.

Function RangeNot(RngA As Range, Optional RngB As Range, _
Optional WS As Worksheet)
' Using Dave Peterson interpretation of Tom Ogilvy's
' scratch sheet
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
'Adapted as a function

Dim wks As Worksheet

If WS Is Nothing Then Set WS = Activesheet

If RngB Is Nothing Then Set RngB = Activesheet.UsedRange

With Union(RngA, RngB).Validation
.Delete
.Add 0, 1
End With

Intersect(RngA, RngB).Validation.Delete

Set RangeNot = Union(RngA, RngB).SpecialCells(xlCellTypeAllValidation)

End Function

---
Regards,
Norman



"keepITcool" wrote in message
...

Hi..

this one's for the experts/mathematicians amongst us..
(Harlan, you reading this ? :)


does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give a
"LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

My theory (and bit of practice too:)

First get the 'outside range' sized from topleft to bottom right cell
of the multiarea.. that's done. (be carefull of unordered areas.)

Then create an array of same dimensions... and mark off the selected
cells. much faster then checking intersect during a 'normal' loop.

But then..? I need an efficient routine to create a a new range object
from that array... Since you want to avoid just dumping every TRUE in
the array in a union and let excel figure it out..

SO probably I need a 'mazing' algorithm but there I'm stuck for the
moment..and I'm pretty sure there must be some nice routines out there!


anyone?..

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

Hi KeepItCool,

I managed to cut/paste/combine and screw that up!

The function should read more along the lines of:

Function RngNot(RngA As Range, _
Optional RngB As Range, _
Optional WS As Worksheet) As Range
'------------------------------
' Using Dave Peterson interpretation of Tom Ogilvy's
' scratch sheet
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
'Adapted as a function
'-----------------------------
If RngB Is Nothing Then Set RngB = ActiveSheet.UsedRange
If WS Is Nothing Then Set WS = ActiveSheet

With Union(RngA, RngB).Validation
.Delete
.Add 0, 1
End With

Intersect(RngA, RngB).Validation.Delete

Set RngNot = Union(RngA, RngB). _
SpecialCells(xlCellTypeAllValidation)
End Function


---
Regards,
Norman



"Norman Jones" wrote in message
...
Hi KeepItCool,

You can see the conversation to which Tom alludes at :

http://tinyurl.com/5yyl4

Stealing acombination of these ideas, I use the following function which,
in
my timings, is significantly faster than loop approaches that i tried.

Function RangeNot(RngA As Range, Optional RngB As Range, _
Optional WS As Worksheet)
' Using Dave Peterson interpretation of Tom Ogilvy's
' scratch sheet
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
'Adapted as a function

Dim wks As Worksheet

If WS Is Nothing Then Set WS = Activesheet

If RngB Is Nothing Then Set RngB = Activesheet.UsedRange

With Union(RngA, RngB).Validation
.Delete
.Add 0, 1
End With

Intersect(RngA, RngB).Validation.Delete

Set RangeNot = Union(RngA, RngB).SpecialCells(xlCellTypeAllValidation)

End Function

---
Regards,
Norman



"keepITcool" wrote in message
...

Hi..

this one's for the experts/mathematicians amongst us..
(Harlan, you reading this ? :)


does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give a
"LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

My theory (and bit of practice too:)

First get the 'outside range' sized from topleft to bottom right cell
of the multiarea.. that's done. (be carefull of unordered areas.)

Then create an array of same dimensions... and mark off the selected
cells. much faster then checking intersect during a 'normal' loop.

But then..? I need an efficient routine to create a a new range object
from that array... Since you want to avoid just dumping every TRUE in
the array in a union and let excel figure it out..

SO probably I need a 'mazing' algorithm but there I'm stuck for the
moment..and I'm pretty sure there must be some nice routines out there!


anyone?..

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

Norman.. this looks very usefull!

there's a few things in the code that could be tightened up.

WS argument can be removed.

if we use this..

if rngB is nothing then set rngB=rngA.Parent.usedrange

we don't need WS..
(rngB and RngA must be on the same sheet for a union to work anyway)

also I want to build in some checks:
in order not to destroy existing Validation...
if there is no intersect
if rngA iss within rngB (or vice versa)


I'll post back tomorrow !!



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Norman Jones wrote :

Hi KeepItCool,

I managed to cut/paste/combine and screw that up!

The function should read more along the lines of:

Function RngNot(RngA As Range, _
Optional RngB As Range, _
Optional WS As Worksheet) As Range
'------------------------------
' Using Dave Peterson interpretation of Tom Ogilvy's
' scratch sheet
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
'Adapted as a function
'-----------------------------
If RngB Is Nothing Then Set RngB = ActiveSheet.UsedRange
If WS Is Nothing Then Set WS = ActiveSheet

With Union(RngA, RngB).Validation
.Delete
.Add 0, 1
End With

Intersect(RngA, RngB).Validation.Delete

Set RngNot = Union(RngA, RngB). _
SpecialCells(xlCellTypeAllValidation)
End Function


---
Regards,
Norman



"Norman Jones" wrote in message
...
Hi KeepItCool,

You can see the conversation to which Tom alludes at :

http://tinyurl.com/5yyl4

Stealing acombination of these ideas, I use the following function
which,
in
my timings, is significantly faster than loop approaches that i
tried.

Function RangeNot(RngA As Range, Optional RngB As Range, _
Optional WS As Worksheet)
' Using Dave Peterson interpretation of Tom Ogilvy's
' scratch sheet
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
'Adapted as a function

Dim wks As Worksheet

If WS Is Nothing Then Set WS = Activesheet

If RngB Is Nothing Then Set RngB = Activesheet.UsedRange

With Union(RngA, RngB).Validation
.Delete
.Add 0, 1
End With

Intersect(RngA, RngB).Validation.Delete

Set RangeNot = Union(RngA,
RngB).SpecialCells(xlCellTypeAllValidation)

End Function

---
Regards,
Norman



"keepITcool" wrote in message
...

Hi..

this one's for the experts/mathematicians amongst us..
(Harlan, you reading this ? :)


does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give
a "LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

My theory (and bit of practice too:)

First get the 'outside range' sized from topleft to bottom right
cell of the multiarea.. that's done. (be carefull of unordered
areas.)

Then create an array of same dimensions... and mark off the
selected cells. much faster then checking intersect during a
'normal' loop.

But then..? I need an efficient routine to create a a new range
object from that array... Since you want to avoid just dumping
every TRUE in the array in a union and let excel figure it out..

SO probably I need a 'mazing' algorithm but there I'm stuck for
the moment..and I'm pretty sure there must be some nice routines
out there!


anyone?..

--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam

Hi KeepItCool,

there's a few things in the code that could be tightened up

The function was derived from something else not immediately pertinent here
.. Hence the initial post and lack of optimisation.

---
Regards,
Norman




"keepITcool" wrote in message
...

Norman.. this looks very usefull!

there's a few things in the code that could be tightened up.

WS argument can be removed.

if we use this..

if rngB is nothing then set rngB=rngA.Parent.usedrange

we don't need WS..
(rngB and RngA must be on the same sheet for a union to work anyway)

also I want to build in some checks:
in order not to destroy existing Validation...
if there is no intersect
if rngA iss within rngB (or vice versa)


I'll post back tomorrow !!



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Norman Jones wrote :

Hi KeepItCool,

I managed to cut/paste/combine and screw that up!

The function should read more along the lines of:

Function RngNot(RngA As Range, _
Optional RngB As Range, _
Optional WS As Worksheet) As Range
'------------------------------
' Using Dave Peterson interpretation of Tom Ogilvy's
' scratch sheet
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
'Adapted as a function
'-----------------------------
If RngB Is Nothing Then Set RngB = ActiveSheet.UsedRange
If WS Is Nothing Then Set WS = ActiveSheet

With Union(RngA, RngB).Validation
.Delete
.Add 0, 1
End With

Intersect(RngA, RngB).Validation.Delete

Set RngNot = Union(RngA, RngB). _
SpecialCells(xlCellTypeAllValidation)
End Function


---
Regards,
Norman



"Norman Jones" wrote in message
...
Hi KeepItCool,

You can see the conversation to which Tom alludes at :

http://tinyurl.com/5yyl4

Stealing acombination of these ideas, I use the following function
which,
in
my timings, is significantly faster than loop approaches that i
tried.

Function RangeNot(RngA As Range, Optional RngB As Range, _
Optional WS As Worksheet)
' Using Dave Peterson interpretation of Tom Ogilvy's
' scratch sheet
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
'Adapted as a function

Dim wks As Worksheet

If WS Is Nothing Then Set WS = Activesheet

If RngB Is Nothing Then Set RngB = Activesheet.UsedRange

With Union(RngA, RngB).Validation
.Delete
.Add 0, 1
End With

Intersect(RngA, RngB).Validation.Delete

Set RangeNot = Union(RngA,
RngB).SpecialCells(xlCellTypeAllValidation)

End Function

---
Regards,
Norman



"keepITcool" wrote in message
...

Hi..

this one's for the experts/mathematicians amongst us..
(Harlan, you reading this ? :)


does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give
a "LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

My theory (and bit of practice too:)

First get the 'outside range' sized from topleft to bottom right
cell of the multiarea.. that's done. (be carefull of unordered
areas.)

Then create an array of same dimensions... and mark off the
selected cells. much faster then checking intersect during a
'normal' loop.

But then..? I need an efficient routine to create a a new range
object from that array... Since you want to avoid just dumping
every TRUE in the array in a union and let excel figure it out..

SO probably I need a 'mazing' algorithm but there I'm stuck for
the moment..and I'm pretty sure there must be some nice routines
out there!


anyone?..

--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam

I'd thought about that, but find it too kludgy.

Norman.. this looks very usefull!

wow, you hooked onto that like a hungry baby to the nipple. <LOL

--
Regards,
Tom Ogilvy

yep.. have you seen how FAST this is. Perfect.

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Tom Ogilvy wrote :

I'd thought about that, but find it too kludgy.

Norman.. this looks very usefull!

wow, you hooked onto that like a hungry baby to the nipple. <LOL

Hi KeepITcool,

I have amended this function taking your comments into account. More
specifically,

WS argument can be removed.

Agreed - I actually intended the WS variable to refer to a variable sheet
but manged to fall between two stools.

if rngB is nothing then set rngB=rngA.Parent.usedrange

Yes - Happily incorporated.

(rngB and RngA must be on the same sheet for a union to work anyway)

Yes - see WS point above.

also I want to build in some checks

in order not to destroy existing Validation...

I agree that this is necessary. I have amended the function to build an
array to store all possible validation variables. Once the function has
determined the RngNot range, the validation data is restored to any
validation cells. I hope that I have caught all possible variables.

if there is no intersect

An On Error Resume ... Goto added to catch this.

if rngA iss within rngB (or vice versa)

I looked at this and felt that no special action was required, Since,
however, you have specifically raised the point, you may see more here than
I did after my , admittedly, somemewhat cursory, consideration.

I think that there is (at leat) one futher point to consider: The 8192
non-contiguous cells limitation which, IIR, applies to pre-xl2002 . I
suppose that the logical step would be to adopt an
iI Intersect(RngA, RngB).Areas.Count 8191 Then
Break rnage into acceptable chunks & loop
End If
appoach.

I wanted to think about this however, not least because, in my testing, the
limit appeared to come into effect close to but definately *before* the
8192. Given other calls on my time, i was unable to rigorously test how far
(if at all) this phenomenon was
due to subtleties of my test parameters or simply error/oversight on my
part.

In any event, this is my revised code:

Function RngNot(RngA As Range, Optional RngB As Range) As Range
'---------------------------------------------
' Using Dave Peterson's interpretation of Tom Ogilvy's
' scratch sheet idea
' Adapted to replace the scratchsheet using Dana DeLouis's
' Validation idea
' Adapted as a function
' Amended to satisfy the need (pointed out by KeepITcool)
' to restore original validation - Validation values passed
' to and from an array
' Amended to add Non-Intersection error handling (KeepITcool)
'---------------------------------------------
Dim Rng As Range, cell As Range, i As Long

If RngB Is Nothing Then Set RngB = RngA.Parent.UsedRange

On Error Resume Next
Set Rng = Union(RngA, RngB).SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0

If Not Rng Is Nothing Then
ReDim arr(1 To Rng.Cells.Count, 1 To 14)
i = 0
For Each cell In Rng
i = i + 1
With cell.Validation
arr(i, 1) = cell.Address
arr(i, 2) = .Type
arr(i, 3) = .AlertStyle
arr(i, 4) = .Operator
arr(i, 5) = .Formula1
arr(i, 6) = .Formula2
arr(i, 7) = .ErrorMessage
arr(i, 8) = .ErrorTitle
arr(i, 9) = .IgnoreBlank
arr(i, 10) = .InputMessage
arr(i, 11) = .InputTitle
arr(i, 12) = .ShowError
arr(1, 13) = .ShowInput
arr(1, 14) = .InCellDropdown
End With
Next cell

Rng.Validation.Delete
End If

Union(RngA, RngB).Validation.Add 0, 1

On Error Resume Next
Intersect(RngA, RngB).Validation.Delete
On Error GoTo 0
Set RngNot = Union(RngA, RngB). _
SpecialCells(xlCellTypeAllValidation)
RngNot.Validation.Delete
If Not Rng Is Nothing Then
For i = LBound(arr) To UBound(arr)
With Range(arr(i, 1)).Validation
.Add Type:=arr(i, 2), AlertStyle:=arr(i, 3), _
Operator:=arr(i, 4), Formula1:=arr(i, 5), _
Formula2:=arr(i, 6)
.ErrorMessage = arr(i, 7)
.ErrorTitle = arr(i, 8)
.IgnoreBlank = arr(i, 9)
.InputMessage = arr(i, 10)
.InputTitle = arr(i, 11)
.ShowError = arr(i, 12)
.ShowInput = arr(1, 13)
.InCellDropdown = arr(1, 14)
End With
Next i
End If
End Function

---
Regards,
Norman

Hi KeepITcool

Typo warning!

In the last two lines of the array load:

arr(1, 13) = .ShowInput
arr(1, 14) = .InCellDropdown

and. analogously, in the last two lines of the array unload

.ShowInput = arr(1, 13)
.InCellDropdown = arr(1, 14)

replace arr(1, with arr(i,


( The legacy of an over-confident search & replace!)

---
Regards,
Norman

Norman..

took a while... sorry.

8192 area bug still unresolved <<<


made my own version of things.. heavily based on your original :)
following alterations:
added the use of formatconditions
finding existing validation via recursive SC(samevalid)
extra option to inverse on the 'outer boundary square' of input rangeA

not utterly tested.. but time is lacking :(
i'll store this for now... more things to do.

thanks for all the input,

Jurgen Volkerink
aka
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam



Function Inverse(rngA As Range, Optional bUsedRange As Boolean, _
Optional rngB As Range) As Range
' Freely adapted by keepitcool from :
' Adapted from Norman Jones 2004 Jul 22 'Inverse Selection
' Adapted from thread 2003 Oct 12 'Don't Intersect
' thread contributors Tom Ogilvy, Dave Peterson, Dana DeLouis

Dim lCnt&, itm, colDV As Collection
Dim iEvt%, iScr%

If rngB Is Nothing Then
If bUsedRange Then
Set rngB = rngA.Parent.UsedRange
Else
Set rngB = Square(rngA)
End If
Else
On Error Resume Next
lCnt= Intersect(rngA, rngB).Count
On Error GoTo 0
If lCnt = 0 Then Exit Function Else lCnt = 0
End If

With Application
iEvt = .EnableEvents: .EnableEvents = False
iScr = .ScreenUpdating: .ScreenUpdating = False
End With

Set colDV = New Collection

With Union(rngA, rngB)

useFC:
On Error Resume Next
lCnt = .SpecialCells(xlCellTypeAllFormatConditions).Count
On Error GoTo 0
If lCnt 0 Then GoTo useDV

.FormatConditions.Add 1, 3, 0
Intersect(rngA, rngB).FormatConditions.Delete
Set Inverse = .SpecialCells(xlCellTypeAllFormatConditions)
Inverse.FormatConditions.Delete
GoTo theExit

useDV:
Do
On Error Resume Next
If IsError(.SpecialCells(xlCellTypeAllValidation)) Then Exit Do
On Error GoTo 0
With Intersect(.Cells, _
.Cells.SpecialCells(xlCellTypeAllValidation) _
.Cells(1).SpecialCells(xlCellTypeSameValidation))

With .Validation
colDV.Add Array(.Parent.Cells, _
.Type, .AlertStyle, .Operator, .Formula1, .Formula2, _
.IgnoreBlank, .InCellDropdown, _
.ShowError, .ErrorTitle, .ErrorMessage, _
.ShowInput, .InputTitle, .InputMessage)
.Delete
End With
End With
Loop

.Validation.Add 0, 1
Intersect(rngA, rngB).Validation.Delete
Set Inverse = .SpecialCells(xlCellTypeAllValidation)
Inverse.Validation.Delete
End With

theExit:
If colDV.Count 0 Then
For Each itm In colDV
With itm(0).Validation
.Add itm(1), itm(2), itm(3), itm(4), itm(5)
.IgnoreBlank = itm(6)
.InCellDropdown = itm(7)
.ShowError = itm(8)
.ErrorTitle = itm(9)
.ErrorMessage = itm(10)
.ShowInput = itm(11)
.InputTitle = itm(12)
.InputMessage = itm(13)
End With
Next
End If

With Application
.EnableEvents = iEvt
.ScreenUpdating = iScr
Exit Function
End With

End Function

Function Square(rng As Range) As Range
'Finds the 'square outer range' of a (multiarea) range
Dim c1&, cn&, r1&, rn&, x1&, xn&, a As Range

r1 = &H10001: c1 = &H101
For Each a In rng.Areas
x1 = a.Row
xn = x1 + a.Rows.Count
If x1 < r1 Then r1 = x1
If xn rn Then rn = xn
x1 = a.Column
xn = x1 + a.Columns.Count
If x1 < c1 Then c1 = x1
If xn cn Then cn = xn
Next
Set Square = rng.Worksheet.Cells(r1, c1).Resize(rn - r1, cn - c1)

End Function

Hi Norman

I have been working with this method to subtract ranges
for some while. I had always attributed this to Dana
DeLouis, but reading the links in this thread it appears
to be a logical development of an old idea of Tom Ogilvy's
(I don't mean to detract anything from Dana's clever idea).

In XL97, but not XL2k, I find problems (crash) restoring
validation from a variant array, and would need to amend
to something like this:

Function RngNot(RngA As Range, Optional RngB As Range) _
As Range
Dim Rng As Range, cell As Range, i As Long
'code

'store validation
Dim cnt As Long
cnt = Rng.Cells.Count
ReDim Narr(1 To cnt, 1 To 3) As Long
ReDim Barr(1 To cnt, 1 To 4) As Boolean
ReDim Sarr(1 To cnt, 1 To 7) As String
i = 0
For Each cell In Rng
i = i + 1
With cell.Validation
Sarr(i, 1) = cell.Address
Narr(i, 1) = .Type
Narr(i, 2) = .AlertStyle
Narr(i, 3) = .Operator
Sarr(i, 2) = .Formula1
Sarr(i, 3) = .Formula2
Sarr(i, 4) = .ErrorMessage
Sarr(i, 5) = .ErrorTitle
Barr(i, 1) = .IgnoreBlank
Sarr(i, 6) = .InputMessage
Sarr(i, 7) = .InputTitle
Barr(i, 2) = .ShowError
Barr(i, 3) = .ShowInput
Barr(i, 4) = .InCellDropdown
End With
Next cell

'code

'replace validation
For i = 1 To cnt
With Range(Sarr(i, 1)).Validation
.Delete 'new line
.Add Type:=Narr(i, 1), AlertStyle:=Abs(Narr(i, 2)), _
Operator:=Narr(i, 3), Formula1:=Sarr(i, 2), _
Formula2:=Sarr(i, 3)
.ErrorMessage = Sarr(i, 4)
.ErrorTitle = Sarr(i, 5)
.IgnoreBlank = Barr(i, 1)
.InputMessage = Sarr(i, 6)
.InputTitle = Sarr(i, 7)
.ShowError = Barr(i, 2)
.ShowInput = Barr(i, 3)
.InCellDropdown = Barr(i, 4)
End With
Next I
'code
End Sub

Couple of comments:

Intermittently, if .AlertStyle is xlValidAlertStop ( a
long 1) it can get returned as -1. I don't know why but
hence AlertStyle:=Abs(Narr(i, 2)), I havn't noticed a
problem with the other longs.

Replacing validation, code can fail if the first line is
not
..Delete
even if there is no existing validation in the cell. Again
I don't know why.

I have also tried similar with collection and a class -
given up! I remain nervous of the possibility of not fully
restoring any validation, even if it's the user getting
bored and trying to abort. So currently I adapt the entire
method so as not to change validation on the user's sheet.
There are at least two reasonable, albeit slower,
workarounds.

I think that there is (at least) one futher point to
consider: The 8192 non-contiguous cells limitation which,
IIR, applies to pre-xl2002. I suppose that the logical
step would be to adopt an
If Intersect(RngA, RngB).Areas.Count 8191 Then
Break rnage into acceptable chunks & loop
End If
appoach.

I wanted to think about this however, not least because,
in my testing, the limit appeared to come into effect
close to but definately *before* the 8192.

In quite a bit of testing of the 8192 areas / special
cells limit, I have never failed to select less than the
full contents in 8192 areas. I suspect the problem here
may be related to use of Intersect with close to this
number of areas (could be my ageing system resources),
rather than specifically the 8192 limit with specialcells.

Even some way below this level various problems can arise,
including the possibility of the user getting bored and
trying to abort (Set Intersect x000 areas takes a while).
For me the 8192 limit is somewhat academic, I would prefer
to break up into say a max 2000 areas in each range. Also,
I suspect 3 x 2000 and union would be faster than 1 x 6000.

I don't have a good method for this - ie split
into "pairs" of smaller chunks. For KeepItCool it might
not be too difficult, he only wants to get the "Inverse"
range. One or both my ranges could include very many
areas, first and last areas might not include top left and
bottom right cells respectively in each range. It has
stumped me - I don't suppose you would have any thoughts
on this!

Regards,
Peter

Grüezi keepITcool

keepITcool schrieb am 23.07.2004

does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give a
"LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

I just found this thread here.
Maybe the following functions could do the 'trick'?


Sub Test()
InversRange(Selection).Select
End Sub

Public Function InversRange(Bereich As Range) As Range
Dim lngI As Long
Dim rngBereich As Range
On Error GoTo err_Select
Set rngBereich = Invers_Area(Bereich.Areas(1))
For lngI = 2 To Bereich.Areas.Count
Set rngBereich = Intersect(rngBereich, _
Invers_Area(Bereich.Areas(lngI)))
Next
Set InversRange = rngBereich
Exit Function
err_Select:
'in dieser Anwendung kann man hier ruhig nothing setzen,
'Activecell war nur benutzt, um eine Fehlermeldung zu vermeiden!
Set InversRange = Nothing
End Function

Private Function Invers_Area(act_select As Range) As Range
On Error Resume Next
Dim part1 As Range
Dim part2 As Range
Dim part3 As Range
Dim part4 As Range
Dim p As Integer
p = 0
If act_select.Row 1 Then
Set part1 = Rows("1:" & act_select.Row - 1)
p = 1
End If
If act_select.Row + act_select.Rows.Count - 1 < 65536 Then
Set part2 = Rows(act_select.Row + act_select.Rows.Count & ":65536")
p = p + 2
End If
If act_select.Column 1 Then
Set part3 = Range(Columns(1), Columns(act_select.Column - 1))
p = p + 4
End If
If act_select.Column + act_select.Columns.Count - 1 < 256 Then
Set part4 = Range(Columns(act_select.Column + _
act_select.Columns.Count), Columns(256))
p = p + 8
End If
Set Invers_Area = Nothing
Do While p 0
Select Case p
'so gefällt es mir inzwischen besser - einfach auf den Kopf gestellt!
Case Is = 8:
If Invers_Area Is Nothing Then
Set Invers_Area = part4
Else
Set Invers_Area = Union(Invers_Area, part4)
End If
p = p - 8
Case Is = 4:
If Invers_Area Is Nothing Then
Set Invers_Area = part3
Else
Set Invers_Area = Union(Invers_Area, part3)
End If
p = p - 4
Case Is = 2:
If Invers_Area Is Nothing Then
Set Invers_Area = part2
Else
Set Invers_Area = Union(Invers_Area, part2)
End If
p = p - 2
Case 1:
If Invers_Area Is Nothing Then
Set Invers_Area = part1
Else
Set Invers_Area = Union(Invers_Area, part1)
End If
p = p - 1
End Select

Loop
End Function

--
Regards

Thomas Ramel
- MVP for Microsoft-Excel -

[Win XP Pro SP-1 / xl2000 SP-3]

Grüezi Thomas!


... bin noch dran das ding zu testen.

Thanks for posting this BUT

compared to the procedures posted earlier in this thread
... which use specialcells and validation/formatconditions.

your code is WAY too slow...

(admittedly on a COMPLEX multiarea.. but that's where our existing idea
is having problems, because of an bug in specialcells (untrappable
error returns a solid range iso a multiarea with more than 8192 areas.)


see.. solves in seconds
what your code takes minutes to do.(if it ever gets there cuz I crashed
it after it was burning my cpu.. 10 minutes at full throttle.. <g

I'm happy with the things we have. Just neeed a final fix for complex
multiaareas.

Also...bin nicht mehr dran es zu testen. es hat jetzt 6 minuten
gelaufen.. und erst 3500 von 9000 areas gefunden...

Leider....



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Thomas Ramel wrote :

Grüezi keepITcool

keepITcool schrieb am 23.07.2004

does anyone have some routines to invert a (multiarea) selection?
or ...along the same line of thought ..

to get the the inverse of intersect.. (generally that would give a
"LEFT" bucket and a "RIGHT" bucket.

It MUST be fast.. thus a simple loop will never suffice.
unions above 400 areas get dreadfully slow..

I just found this thread here.
Maybe the following functions could do the 'trick'?


Sub Test()
InversRange(Selection).Select
End Sub

Public Function InversRange(Bereich As Range) As Range
Dim lngI As Long
Dim rngBereich As Range
On Error GoTo err_Select
Set rngBereich = Invers_Area(Bereich.Areas(1))
For lngI = 2 To Bereich.Areas.Count
Set rngBereich = Intersect(rngBereich, _
Invers_Area(Bereich.Areas(lngI)))
Next
Set InversRange = rngBereich
Exit Function
err_Select:
'in dieser Anwendung kann man hier ruhig nothing setzen,
'Activecell war nur benutzt, um eine Fehlermeldung zu vermeiden!
Set InversRange = Nothing
End Function

Private Function Invers_Area(act_select As Range) As Range
On Error Resume Next
Dim part1 As Range
Dim part2 As Range
Dim part3 As Range
Dim part4 As Range
Dim p As Integer
p = 0
If act_select.Row 1 Then
Set part1 = Rows("1:" & act_select.Row - 1)
p = 1
End If
If act_select.Row + act_select.Rows.Count - 1 < 65536 Then
Set part2 = Rows(act_select.Row + act_select.Rows.Count & ":65536")
p = p + 2
End If
If act_select.Column 1 Then
Set part3 = Range(Columns(1), Columns(act_select.Column - 1))
p = p + 4
End If
If act_select.Column + act_select.Columns.Count - 1 < 256 Then
Set part4 = Range(Columns(act_select.Column + _
act_select.Columns.Count), Columns(256))
p = p + 8
End If
Set Invers_Area = Nothing
Do While p 0
Select Case p
'so gefällt es mir inzwischen besser - einfach auf den Kopf
gestellt! Case Is = 8:
If Invers_Area Is Nothing Then
Set Invers_Area = part4
Else
Set Invers_Area = Union(Invers_Area, part4)
End If
p = p - 8
Case Is = 4:
If Invers_Area Is Nothing Then
Set Invers_Area = part3
Else
Set Invers_Area = Union(Invers_Area, part3)
End If
p = p - 4
Case Is = 2:
If Invers_Area Is Nothing Then
Set Invers_Area = part2
Else
Set Invers_Area = Union(Invers_Area, part2)
End If
p = p - 2
Case 1:
If Invers_Area Is Nothing Then
Set Invers_Area = part1
Else
Set Invers_Area = Union(Invers_Area, part1)
End If
p = p - 1
End Select

Loop
End Function

Grüezi keepITcool

keepITcool schrieb am 27.07.2004

Thanks for posting this BUT

compared to the procedures posted earlier in this thread
.. which use specialcells and validation/formatconditions.

your code is WAY too slow...

I thougt so, but posted it anyway

(admittedly on a COMPLEX multiarea.. but that's where our existing idea
is having problems, because of an bug in specialcells (untrappable
error returns a solid range iso a multiarea with more than 8192 areas.)

see.. solves in seconds
what your code takes minutes to do.(if it ever gets there cuz I crashed
it after it was burning my cpu.. 10 minutes at full throttle.. <g

I'm happy with the things we have. Just neeed a final fix for complex
multiaareas.

I didn't read and study all the posts in the thread, but would like to
'borrow' the code for an add-in i lately wrote.
In there I'm able to reduce a multi-area selection by selecting the cells I
marked and sidn't wanted to.

Also...bin nicht mehr dran es zu testen. es hat jetzt 6 minuten
gelaufen.. und erst 3500 von 9000 areas gefunden...

Leider....

No harm done to me, just my 2c.

--
Regards

Thomas Ramel
- MVP for Microsoft-Excel -

[Win XP Pro SP-1 / xl2000 SP-3]

get the the inverse of intersect

For your amusement...

Sub Test()
NotIntersect(Selection, Application.InputBox("", , , , , , ,
8)).Select
End Sub

Function NotIntersect(rng As Range, x As Range) As Range
' copyright 2001-2004 Jim Wilcox
Dim y As Range
On Error Resume Next
If rng.Parent Is x.Parent Then
With x
Set y = myUnion(y, Range(Rows(1), .Rows(0)))
Set y = myUnion(y, Range(Rows(Rows.Count), .Rows(.Rows.Count +
1)))
Set y = Intersect(y, .EntireColumn)
Set y = myUnion(y, Range(Columns(1), .Columns(0)))
Set y = myUnion(y, _
Range(Columns(Columns.Count), .Columns(.Columns.Count + 1)))
Set y = Intersect(y, rng)
End With
Set NotIntersect = y
End If
On Error GoTo 0
End Function

Private Function myUnion(o As Range, rng As Range) As Range
On Error Resume Next
If o Is Nothing Then
Set myUnion = rng
ElseIf rng Is Nothing Then
Set myUnion = o
Else
Set myUnion = Union(o, rng)
End If
On Error GoTo 0
End Function

-Jim (see Organization field to figure out email address)

Hi Jim,

I suspect KeepITcool is doing the sensible thing and gone
on holiday, hence a reply from me.

This looks interesting but I cannot get it to work
correctly, a dot or two out of place perhaps. I had a go
with something similar, didn't pursue when KeepITcool
warned me off the idea (with large ranges).

As time's gone by a quick recap -

To get a pure inverted range, eg
Set RngA = Range("b2:c3,f3:g4")
Set RngB = Range("b2:g4") 'square or outer RngA

Set rInverted = rFunc(RngA, RngB)

Debug.? rInverted.Address
$B$4:$C$4,$D$2:$E$4,$F$2:$G$2

For my, and I think Norman's purposes, to subtract ranges
whose "outer" areas may only partially intersect. Also,
either/both ranges could be single or multiple. The
functions in this thread are set up to subtract Intersect
(RngA,RngB) from Union(RngA,RngB), but easily adapted to
subtract whatever. Eg:

Set RngA = Range("B2:C3,F3:G4")
Set RngB = Range("B3:B5,C3:G3")

Set rSubtracted = rFunc(RngA, RngB)
' subtract Intersect from Union

Debug.? rSubtracted.address
$F$4:$G$4,$B$4:$B$5,$B$2:$C$2,$D$3:$E$3

I would expect your code to be slower than the methods
discussed, but good for smaller ranges to avoid using DV
or CF. As it stands it does not appear to return the non-
intersecting areas of the ranges thrown at it. I'm hoping
I've missed something obvious and looking forward to one
of those Doh moments :)

Regards,
Peter


-----Original Message-----
get the the inverse of intersect

For your amusement...

Sub Test()
NotIntersect(Selection, Application.InputBox
("", , , , , , ,
8)).Select
End Sub

Function NotIntersect(rng As Range, x As Range) As Range
' copyright 2001-2004 Jim Wilcox
Dim y As Range
On Error Resume Next
If rng.Parent Is x.Parent Then
With x
Set y = myUnion(y, Range(Rows(1), .Rows(0)))
Set y = myUnion(y, Range(Rows(Rows.Count), .Rows
(.Rows.Count +
1)))
Set y = Intersect(y, .EntireColumn)
Set y = myUnion(y, Range(Columns(1), .Columns(0)))
Set y = myUnion(y, _
Range(Columns(Columns.Count), .Columns
(.Columns.Count + 1)))
Set y = Intersect(y, rng)
End With
Set NotIntersect = y
End If
On Error GoTo 0
End Function

Private Function myUnion(o As Range, rng As Range) As
Range
On Error Resume Next
If o Is Nothing Then
Set myUnion = rng
ElseIf rng Is Nothing Then
Set myUnion = o
Else
Set myUnion = Union(o, rng)
End If
On Error GoTo 0
End Function

-Jim (see Organization field to figure out email address)
.

This looks interesting but I cannot get it to work
correctly, a dot or two out of place perhaps.

No.

If you can't get it to work let me help. What was the error message and
line?

-Jim

This looks interesting but I cannot get it to work
correctly, a dot or two out of place perhaps.

No.

If you can't get it to work let me help. What was the
error message and
line?

-Jim

Jim,

Not directly a code halting with an error but more a case
of as I also mentioned last post:

As it stands it does not appear to return the non-
intersecting areas of the ranges thrown at it.


With the examples I posted:

Sub test2()
Dim RngA As Range, RngB As Range

Set RngA = Range("b2:c3,f3:g4")
Set RngB = Range("b2:g4") 'square or outer RngA

Set RngA = NotIntersect(RngA, RngB)
RngA.Select
Debug.Print RngA.Address
End Sub

Here, RngA.Select errors because, in your func:
Set y = Intersect(y, rng) is a non intersecting range,
hence the function returns a non existant range.

Or,

Set RngB = Range("B2:C3,F3:G4")
Set RngA = Range("B3:B5,C3:G3")
Set RngA = NotIntersect(RngA, RngB)

RngA.address returns: B4:B5,D3:G3
Instead of: F4:G4,B4:B5,B2:C2,D3:E3 ($'s trimmed)

Have I missed something?

Regards,
Peter

Have I missed something?

Yes.

Function NotIntersect(rng As Range, x As Range) As Range

rng is the source
x is the range to be removed from the source

I presented the function in such a way that x should be a single-area
range, because calling the function within a loop...

for each x in bigx.Areas
NotIntersect(Selection, x).Select

....or whatever, would be a trivial exercise for the reader, and would
detract from understanding the basic and very simple concept of what my
code achieves, extremely efficiently.

-Jim

Hi, Jim:

I was intrigued by your code. I tried it with the following

Sub Test()
Dim R As Range
Set R = NotIntersect(Range("a2:d5"), Range("b3:c4"))
If R Is Nothing Then
MsgBox ("Nothing!")
Else
MsgBox R.Address
End If

Set R = NotIntersect(Range("b3:c4"), Range("a2:d5"))
If R Is Nothing Then
MsgBox ("Nothing!")
Else
MsgBox R.Address
End If
End Sub

The first call works fine -- it would select all cells in A2:D5 except B3:C4.
The 2nd line SHOULD produce the same result, right? But it doesn't. It returns
Nothing.

Also, if I call it with ranges A2:D5 and B3:D6, in that order, it does not
include cells B6:D6, which are part of the 2nd range but not of the 1st.

The routine would seem to require that the one range is entirely included in
the other, and the larger range must be specified first. Was that your intent?


On Wed, 04 Aug 2004 12:11:37 -0700, "jim.wilcox" wrote:

get the the inverse of intersect

For your amusement...

Sub Test()
NotIntersect(Selection, Application.InputBox("", , , , , , ,
8)).Select
End Sub

Function NotIntersect(rng As Range, x As Range) As Range
' copyright 2001-2004 Jim Wilcox
Dim y As Range
On Error Resume Next
If rng.Parent Is x.Parent Then
With x
Set y = myUnion(y, Range(Rows(1), .Rows(0)))
Set y = myUnion(y, Range(Rows(Rows.Count), .Rows(.Rows.Count +
1)))
Set y = Intersect(y, .EntireColumn)
Set y = myUnion(y, Range(Columns(1), .Columns(0)))
Set y = myUnion(y, _
Range(Columns(Columns.Count), .Columns(.Columns.Count + 1)))
Set y = Intersect(y, rng)
End With
Set NotIntersect = y
End If
On Error GoTo 0
End Function

Private Function myUnion(o As Range, rng As Range) As Range
On Error Resume Next
If o Is Nothing Then
Set myUnion = rng
ElseIf rng Is Nothing Then
Set myUnion = o
Else
Set myUnion = Union(o, rng)
End If
On Error GoTo 0
End Function

-Jim (see Organization field to figure out email address)

Was that your intent?

Yes.

-Jim (see Organization field to figure out email address)

P.S. I come from the old school of usenet. I mean, for questions like
these, it seems to me that email is more appropriate, no?

P.S. I come from the old school of usenet. I mean, for questions like
these, it seems to me that email is more appropriate, no?

I don't agree. I thought the purpose of these discussions was to help other
users. Seeing only part of the discussion doesn't help them...

PS: My confusion is coming from the the name of your routine and the fact that
I haven't followed this thread.

Given the name, NonIntersect, I expected the routine to take two ranges,
create their union, then remove their intersection.

I see from your comments in another message that you want to take the first
range and remove from it any cells that are also part of the 2nd range. That's
not the problem I expected, but presumably it's what the OP wanted.


On Fri, 06 Aug 2004 16:14:01 -0700, "jim.wilcox" wrote:

Was that your intent?

Yes.

-Jim (see Organization field to figure out email address)

P.S. I come from the old school of usenet. I mean, for questions like
these, it seems to me that email is more appropriate, no?

Re email:

If I display the header fields, the organization field gives your company
name, not your email address at the company. I use Agent as my newsreader.
Perhaps Outlook Express is different.

these, it seems to me that email is more appropriate, no?