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

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

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

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

Hi Jurgen,

I have, as yet, only been able fleetingly to scan read your code as She who
must be obeyed commands my presence.

I will respond in more detail later but two quick, off-the-cuff comments::

(1) I like your idea of conditionally employing CF instead of DV if CF
is not in use. Immediately I am tempted to consider alternatives to either
option. One or two likely candidates spring to mind for later consideration
....

(2) The follwing lines from your code concern me:

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

Where no (optional) rRngB is passed to the Inverse function, RngB will, via
your Square function. be set to Range A. In consequence, Union(RngA,RngB)
and Intersect(RngA, RngB) will be coincident. In this situation you are
applying (and immediateley removing) conditional formatting from the
coincident range and, consequently, your Inverse range never gets set and is
returned as Nothing!

But then again, my scan reading was never wonderful!


By the way, I like the collection idea too!


---
Regards,
Norman

Hi Peter,

Your post requires more time than is immediately available to me, but, for
the moment, the briefest anf most telegrammatic of responses:

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).

Dana's implentation is wonderful but the Eureka accolade must be for the
simplicity and elegance of Tom Ogilvy's intrinsic 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:

I was not aware of this version problem. At first blush, your suggestion
looks very viable. I will try on xl97 as soon as I can locate an operational
version.

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.


Was not aware of this, thanks for the information!

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.

This has to be for later!!


Thank you for your detailed post and apologies for not, immediately,
devoting the response time that it warrants.

---
Regards,
Norman

Dana's implentation is wonderful but the Eureka accolade must be for the
simplicity and elegance of Tom Ogilvy's intrinsic idea!

implentation ?!!!

Should be implementation - I really was in a rush!


___
Regards,
Norman

Hi KeepITcool,


Where no (optional) rRngB is passed to the Inverse function, RngB will,
via ...

should have read :

Where RngA is a single area and no (optional) rRngB is passed to the Inverse
function, RngB will, via ...

Apologies for inavertently misleading you.

In light testing, with the sole exception of the single-area RngA / no
explicit RngB scenario, your function version worked excellently and
returned the anticipated range object.

For my purposes, I overcame this problem by changing the opening function
clauses from:

If rngB Is Nothing Then
If bUsedRange Then
Set rngB = rngA.Parent.UsedRange
Else
Set rngB = Square(rngA)
End If
Else

to:

If rngB Is Nothing Then
If bUsedRange Then
Set rngB = rngA.Parent.UsedRange
Else
If rngA.Areas.Count 1 Then
Set rngB = Square(rngA)
Else
Set rngB = rngA.Parent.UsedRange
End If
End If
Else



---
Regards,
Norman

Problem with testing re 8192..

if it's more than 8192 areas then SpecialCells will return 1 solid
range. no error. So you cant test for 8191.

I've done exhaustive testing on this... it's either 8192 or 1.
(regardless of the size/shape of the individual areas.)

Bug is still there in Excel 2003.

although M$ phrases it somewhat differently...

The Excel VBA function ".SpecialCells(xlCellTypeBlanks)" does not work
as expected
<http://support.microsoft.com/default.aspx?scid=kb;en-us;832293
snippet.. just for laughs :)
However, when you use a VBA macro to make the same or a similar
selection, no error message is raised and no error code is generated
that can be captured through an error handler.
======================================
STATUS:This behavior is by design.
======================================


If you want to test yourself..

Sub SpecialCellsCantHandleMoreThan8192AreasBugDemo()
Dim r&, c&, n&, rs As Range
Dim v(1 To 2 ^ 16, 1 To 1)
'Fill cells alternating
Cells.Clear
n = ActiveSheet.UsedRange.Count
For r = LBound(v, 1) To UBound(v, 1)
For c = LBound(v, 2) To UBound(v, 2)
If (r + c) Mod 2 = 0 Then v(r, c) = 1
Next
Next
Cells(1, 1).Resize(UBound(v, 1), UBound(v, 2)) = v
'Now let's use SpecialCells to find the blanks
For r = 8192 To 8193

With Cells(1, 1).Resize(2 * r, 1)
With .SpecialCells(xlBlanks)
.Select
If .Areas.Count 1 Then
MsgBox "8192 areas found.. 1 more?"
Else
MsgBox "Oops.. SpecialCells cant handle more than 8192 areas"
& _
vbNewLine & "it will NOT throw an error, but return 1
large area instead" & _
vbNewLine & Application.CountBlank(.Cells) & " blank
cells s/b selected", vbCritical, "BugDemo"
End If
End With
End With
Next
End Sub




You MUST test for 1. Cuz that's the danger point.

Re problems with array.. wouldn't explicit type conversion
in the restore phase be enough?




I'll read all the comments tomorrow.

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


Peter T wrote :

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).

[snap]

Hi Peter,

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.

Here is a simple sub which (for me!) returns 1 and 8192 where, in each case,
I would anticipate 8192. When I looked at this last week, I appeared to get
erratic results as the number of non-contiguous areas appoached 8192 and as
the nature/complexity of the parent union ranges increased.

Sub Tester()
Range("A1:B1").Value = CVErr(xlErrNA)
Range("A1:C1").Copy Range("d1:o1")
Range("A2:O2").Value = "A"
Range("A1:o2").AutoFill Destination:=Range("A1:O3277"), _
Type:=xlFillDefault
Range("F3277:O3277").Clear
ActiveSheet.UsedRange.Columns.AutoFit

MsgBox ActiveSheet.UsedRange.SpecialCells(xlCellTypeConst ants, _
xlErrors).Areas.Count
Range("E3277").Clear
MsgBox ActiveSheet.UsedRange.SpecialCells(xlCellTypeConst ants, _
xlErrors).Areas.Count
End Sub

I agree, however, that for present purposes at least, this is academic as:
(1) there is *a* limit (be it at 8192 or, sometimes, slightly less)
(2) processing time increases disproportionately above (say) 4500 areas

It clearly is both necessary and expedient to segment the ranges. The
methodology for this is something that I am lookong at now.

---
Regards,
Norman

Norman..

How's this for methodology?
Presuming a selection cannot have more areas than 50% of cells...
This will return a collection of ranges..
Probably should be classed .. but goes to show the idea.

Done some basic testing but even at a:z60000 with 40% random non
blanks.. returned 48 multiarea ranges(avg 7500 areas/range)in the
collection. 90secs.. (1200k cells..372k areas.. but NO errors !

so far so good :)



Function SegmentedCells(rngA As Range, scType As XlCellType, _
Optional scValue As XlSpecialCellsValue) As Collection

Const m = 8192
Dim r&, l&, s&, rngT As Range, colRaw As Collection

Set colRaw = New Collection
Set SegmentedCells = New Collection

With rngA
If .Areas.Count 1 Then
Err.Raise vbObjectError + 1, , "No MultiArea as input."
Exit Function
End If
s = (m * 2 \ .Columns.Count)
l = s
If scValue = 0 Then
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType)
Next
Else
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType, _
scValue)
Next
End If
End With


Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192 Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

End Function


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


Norman Jones wrote :

I agree, however, that for present purposes at least, this is
academic as: (1) there is a limit (be it at 8192 or, sometimes,
slightly less) (2) processing time increases disproportionately
above (say) 4500 areas

It clearly is both necessary and expedient to segment the ranges. The
methodology for this is something that I am lookong at now.

---
Regards,
Norman

Hi KeepITcool,

Given your time zone, this must be important to you.

How's this for methodology?
Your function approach looks good.

so far so good :)
As the blind man said, stepping off the cliff!


I've been thinking of a different approach which is either very sensible or
utter lunacy.
I am loathe to say more for obvious reasons!

By the way, the Inverse function should error check that RngA <
Usedrange - Obvious, but I failed to allow for it.


---
Regards,
Norman

Hi KeepITCool

Hope you don't mind my squeezing into your thread.
Really like the CF alternative, gives extra possibilities.

A couple of things with the DV collection if "Goto useDV".
Similar as I mentioned to Norman, in xl97 would need to
change:

With itm(0).Validation
..Add itm(1), itm(2), itm(3), itm(4), itm(5)
to
..Add itm(1), Abs(itm(2)), itm(3), itm(4), itm(5)

The DV Collection correctly replaces, but when doing this:

ActiveCell.SpecialCells(xlCellTypeAllValidation).S elect

I get a perfect jigsaw of areas, rather than the single
area of DV I had originally applied over everything. Using
the array method, when done I end up with the original
single area of DV.

Regards,
Peter



Function Inverse(rngA As Range, Optional bUsedRange As
Boolean, _
'code

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

'code

End Function

Hi Norman

Thanks for your replies.

Here is a simple sub which (for me!) returns 1 and 8192
where, in each case, I would anticipate 8192.

Yes I see what you mean, don't know how I missed that. In
the first run max areas is 8191. Similar results manually
with F5 special.

(2) processing time increases disproportionately above
(say) 4500 areas

Executing the single line of code to get the 8191/2
specialcells took 50 sec in my system. Valves getting very
hot, about time I upgraded to transistors!

It clearly is both necessary and expedient to segment the
ranges. The methodology for this is something that I am
looking at now

I'm looking forward to your ideas. A toughy - areas at the
boundaries of "pairs" of segments could overlap into
neighbours, might not fill into nice "outer" rectangles.

I had played around with a function very similar to
KeepITcool's "Square" function, although I was trying to
do something with less looping. FWIW here's the seed of
another idea I played with to reduce looping.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function

Sub Test1()
Dim rMulti As Range, rRect As Range, a As Range
Dim i As Long
Cells.Clear

'first range has no totally empty rows/cols
Set rMulti = _
Range("C1:C2,D3:D4,E5:E6,B7:B8")

'Set rMulti = _
Range("C1:C2,E4:E5,G7:G8,B10:B11")

For Each a In rMulti.Areas
i = i + 1
a.Value = i
Next

rRect2(rMulti).Select
MsgBox Selection.Address
End Sub

Regards,
Peter

PS I'm a bit behind, not yet looked at KeepItcool's
"How's this for methodology?"

Dana's implentation is wonderful but the Eureka accolade
must be for the simplicity and elegance of Tom Ogilvy's
intrinsic idea!

Indeed, and nicely expressed.
I can't help wonder if Tom might have allowed a wry
chuckle to himself at the notion he might be surprised by
the speed of this approach <vbg (earlier this thread).

implentation ?!!!
Should be implementation - I really was in a rush!

I really didn't notice until you corrected. Worrying - I
use the same eyes for reading my own code!

Peter

Hi Peter,

on the contrary thanks for budding in :)

i'm collecting answers here from multi branches in this thread...

this is off the cuff.. no testing.

do you mean that
a: the selection is incorrect
or
b: that the 'areas' are only 'jumbled'

this seems due to fact that any union or intersect is build from the
ACTIVEcell forwards.. and wraps around at the end.. first selected
cell..alas afaik no easy way to recreate/reorder a 'hashed' multiarea :(

(hence the threads' title?)

'============================
re other thread Square():
'============================
Peter.. be careful there..

i'had already done some speedtesting.
looping may not look cool.
and all the variables may not look cool either..

you CANNOT depend on the SEQUENCE of multiareas.
using entirerow/column definitely slows it down.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function


'================================
Re How's this for methodology..
'================================
Significant speed improvement if following change is made to
prevent (slow) reunions when either multia is 4096.
(disproportionate etc :)


change THIS

Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192 Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

to THIS:
Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count m \ 2 Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT


i've got the feeling we'll be back :)


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


Peter T wrote :

Hi KeepITCool

Hope you don't mind my squeezing into your thread.
Really like the CF alternative, gives extra possibilities.

A couple of things with the DV collection if "Goto useDV".
Similar as I mentioned to Norman, in xl97 would need to
change:

With itm(0).Validation
.Add itm(1), itm(2), itm(3), itm(4), itm(5)
to
.Add itm(1), Abs(itm(2)), itm(3), itm(4), itm(5)

The DV Collection correctly replaces, but when doing this:

ActiveCell.SpecialCells(xlCellTypeAllValidation).S elect

I get a perfect jigsaw of areas, rather than the single
area of DV I had originally applied over everything. Using
the array method, when done I end up with the original
single area of DV.

Regards,
Peter



Function Inverse(rngA As Range, Optional bUsedRange As
Boolean, _
'code

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

'code

End Function

Hi KeepITcool

do you mean that
a: the selection is incorrect
or
b: that the 'areas' are only 'jumbled'

I meant b: DV is correctly restored using the Collection,
but in a bunch of jumbled areas, rather than the single
area I had applied over everything before testing. I had
thrown two multiple, partially intersecting ranges at
your "Inverse" function. With same test ranges and
Norman's array of DV, I end up with the original single
area of DV. Somehow I forgot to add explanation in my last
post!

Typically a user is unlikely to start with many areas of
DV on his sheet. But could have (say) a couple of columns
of several thousand rows of identical DV - but that's only
one or two areas. Depending on what one's doing, and I
appreciate this might not be applicable in your scenario,
one could end up correctly restoring DV but as several
"jumbled" areas. Not sure what if any implications this
might have, but I would prefer to avoid.

'============================
re other thread Square():
'============================
Peter.. be careful there..

you CANNOT depend on the SEQUENCE of multiareas.
using entirerow/column definitely slows it down.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function

I had played with this as a precursor to finding
the "outer" coordinates of a multiple range. Idea was
looping this would be faster than looping all the areas.
But I didn't get very far.


'================================
Re How's this for methodology..
'================================
Significant speed improvement if following change is made
to prevent (slow) reunions when either multia is 4096.

4096, or even perhaps 2048?

At this point I need to say that my vba skills are several
pegs down the ladder from those of yours and Norman's -
I have not yet worked out how to use or implement
your "SegmentedCells" function in context. It looks clever
and useful - I'll get there in the end!

A quickie -

Presuming a selection cannot have more areas than 50%
of cells...

I think that depends how the range is created.
Theoretically, after adding / subtracting, I could end up
with:

MsgBox Range("a1,b2,a2,b1").Areas.Count
'or "C1,B2:C2,A3:B3,B4:C4,C5" '5 areas 8 cells

i've got the feeling we'll be back :)

Quicker than you thought!

Regards,
Peter



-----Original Message-----
Hi Peter,

on the contrary thanks for budding in :)

i'm collecting answers here from multi branches in this
thread...

this is off the cuff.. no testing.

do you mean that
a: the selection is incorrect
or
b: that the 'areas' are only 'jumbled'

this seems due to fact that any union or intersect is
build from the
ACTIVEcell forwards.. and wraps around at the end.. first
selected
cell..alas afaik no easy way to recreate/reorder
a 'hashed' multiarea :(

(hence the threads' title?)

'============================
re other thread Square():
'============================
Peter.. be careful there..

i'had already done some speedtesting.
looping may not look cool.
and all the variables may not look cool either..

you CANNOT depend on the SEQUENCE of multiareas.
using entirerow/column definitely slows it down.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function


'================================
Re How's this for methodology..
'================================
Significant speed improvement if following change is made
to
prevent (slow) reunions when either multia is 4096.
(disproportionate etc :)


change THIS

Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192
Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

to THIS:
Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count m \ 2
Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT


i've got the feeling we'll be back :)


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


Peter T wrote :

Hi KeepITCool

Hope you don't mind my squeezing into your thread.
Really like the CF alternative, gives extra
possibilities.

A couple of things with the DV collection if "Goto
useDV".
Similar as I mentioned to Norman, in xl97 would need to
change:

With itm(0).Validation
.Add itm(1), itm(2), itm(3), itm(4), itm(5)
to
.Add itm(1), Abs(itm(2)), itm(3), itm(4), itm(5)

The DV Collection correctly replaces, but when doing
this:

ActiveCell.SpecialCells(xlCellTypeAllValidation).S elect

I get a perfect jigsaw of areas, rather than the single
area of DV I had originally applied over everything.
Using
the array method, when done I end up with the original
single area of DV.

Regards,
Peter



Function Inverse(rngA As Range, Optional bUsedRange
As
Boolean, _
'code

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

'code

End Function


.

Hi Peter,

I think that depends how the range is created.
Theoretically, after adding / subtracting, I could end up
with:

MsgBox Range("a1,b2,a2,b1").Areas.Count
'or "C1,B2:C2,A3:B3,B4:C4,C5" '5 areas 8 cells


I think that this is misleading. I think the central issue is the number of
non-contiguous areas.

Also, consider:

? range("A1,A2,A3,A4").Areas.Count
4


---
regards,
Norman



"Peter T" wrote in message
...
Hi KeepITcool

do you mean that
a: the selection is incorrect
or
b: that the 'areas' are only 'jumbled'

I meant b: DV is correctly restored using the Collection,
but in a bunch of jumbled areas, rather than the single
area I had applied over everything before testing. I had
thrown two multiple, partially intersecting ranges at
your "Inverse" function. With same test ranges and
Norman's array of DV, I end up with the original single
area of DV. Somehow I forgot to add explanation in my last
post!

Typically a user is unlikely to start with many areas of
DV on his sheet. But could have (say) a couple of columns
of several thousand rows of identical DV - but that's only
one or two areas. Depending on what one's doing, and I
appreciate this might not be applicable in your scenario,
one could end up correctly restoring DV but as several
"jumbled" areas. Not sure what if any implications this
might have, but I would prefer to avoid.

'============================
re other thread Square():
'============================
Peter.. be careful there..

you CANNOT depend on the SEQUENCE of multiareas.
using entirerow/column definitely slows it down.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function

I had played with this as a precursor to finding
the "outer" coordinates of a multiple range. Idea was
looping this would be faster than looping all the areas.
But I didn't get very far.


'================================
Re How's this for methodology..
'================================
Significant speed improvement if following change is made
to prevent (slow) reunions when either multia is 4096.

4096, or even perhaps 2048?

At this point I need to say that my vba skills are several
pegs down the ladder from those of yours and Norman's -
I have not yet worked out how to use or implement
your "SegmentedCells" function in context. It looks clever
and useful - I'll get there in the end!

A quickie -

Presuming a selection cannot have more areas than 50%
of cells...

I think that depends how the range is created.
Theoretically, after adding / subtracting, I could end up
with:

MsgBox Range("a1,b2,a2,b1").Areas.Count
'or "C1,B2:C2,A3:B3,B4:C4,C5" '5 areas 8 cells

i've got the feeling we'll be back :)

Quicker than you thought!

Regards,
Peter



-----Original Message-----
Hi Peter,

on the contrary thanks for budding in :)

i'm collecting answers here from multi branches in this
thread...

this is off the cuff.. no testing.

do you mean that
a: the selection is incorrect
or
b: that the 'areas' are only 'jumbled'

this seems due to fact that any union or intersect is
build from the
ACTIVEcell forwards.. and wraps around at the end.. first
selected
cell..alas afaik no easy way to recreate/reorder
a 'hashed' multiarea :(

(hence the threads' title?)

'============================
re other thread Square():
'============================
Peter.. be careful there..

i'had already done some speedtesting.
looping may not look cool.
and all the variables may not look cool either..

you CANNOT depend on the SEQUENCE of multiareas.
using entirerow/column definitely slows it down.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function


'================================
Re How's this for methodology..
'================================
Significant speed improvement if following change is made
to
prevent (slow) reunions when either multia is 4096.
(disproportionate etc :)


change THIS

Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192
Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

to THIS:
Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count m \ 2
Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT


i've got the feeling we'll be back :)


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


Peter T wrote :

Hi KeepITCool

Hope you don't mind my squeezing into your thread.
Really like the CF alternative, gives extra
possibilities.

A couple of things with the DV collection if "Goto
useDV".
Similar as I mentioned to Norman, in xl97 would need to
change:

With itm(0).Validation
.Add itm(1), itm(2), itm(3), itm(4), itm(5)
to
.Add itm(1), Abs(itm(2)), itm(3), itm(4), itm(5)

The DV Collection correctly replaces, but when doing
this:

ActiveCell.SpecialCells(xlCellTypeAllValidation).S elect

I get a perfect jigsaw of areas, rather than the single
area of DV I had originally applied over everything.
Using
the array method, when done I end up with the original
single area of DV.

Regards,
Peter



Function Inverse(rngA As Range, Optional bUsedRange
As
Boolean, _
'code

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

'code

End Function


.

If you define the range as 4 separate cells (4 references, separated by
commas, rather than A1:A4), then it has 4 areas.

The following line executed in the immediate window, prints 1:

? union(Range("A1"),Range("A2"),Range("A3"),Range("A 4")).Areas.Count
1

If I change "A4" to "D4", it prints 2.

On Mon, 26 Jul 2004 19:05:28 +0100, "Norman Jones"
wrote:

Hi Peter,

I think that depends how the range is created.
Theoretically, after adding / subtracting, I could end up
with:

MsgBox Range("a1,b2,a2,b1").Areas.Count
'or "C1,B2:C2,A3:B3,B4:C4,C5" '5 areas 8 cells


I think that this is misleading. I think the central issue is the number of
non-contiguous areas.

Also, consider:

? range("A1,A2,A3,A4").Areas.Count
4


---
regards,
Norman



"Peter T" wrote in message
...
Hi KeepITcool

do you mean that
a: the selection is incorrect
or
b: that the 'areas' are only 'jumbled'

I meant b: DV is correctly restored using the Collection,
but in a bunch of jumbled areas, rather than the single
area I had applied over everything before testing. I had
thrown two multiple, partially intersecting ranges at
your "Inverse" function. With same test ranges and
Norman's array of DV, I end up with the original single
area of DV. Somehow I forgot to add explanation in my last
post!

Typically a user is unlikely to start with many areas of
DV on his sheet. But could have (say) a couple of columns
of several thousand rows of identical DV - but that's only
one or two areas. Depending on what one's doing, and I
appreciate this might not be applicable in your scenario,
one could end up correctly restoring DV but as several
"jumbled" areas. Not sure what if any implications this
might have, but I would prefer to avoid.

'============================
re other thread Square():
'============================
Peter.. be careful there..

you CANNOT depend on the SEQUENCE of multiareas.
using entirerow/column definitely slows it down.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function

I had played with this as a precursor to finding
the "outer" coordinates of a multiple range. Idea was
looping this would be faster than looping all the areas.
But I didn't get very far.


'================================
Re How's this for methodology..
'================================
Significant speed improvement if following change is made
to prevent (slow) reunions when either multia is 4096.

4096, or even perhaps 2048?

At this point I need to say that my vba skills are several
pegs down the ladder from those of yours and Norman's -
I have not yet worked out how to use or implement
your "SegmentedCells" function in context. It looks clever
and useful - I'll get there in the end!

A quickie -

Presuming a selection cannot have more areas than 50%
of cells...

I think that depends how the range is created.
Theoretically, after adding / subtracting, I could end up
with:

MsgBox Range("a1,b2,a2,b1").Areas.Count
'or "C1,B2:C2,A3:B3,B4:C4,C5" '5 areas 8 cells

i've got the feeling we'll be back :)

Quicker than you thought!

Regards,
Peter



-----Original Message-----
Hi Peter,

on the contrary thanks for budding in :)

i'm collecting answers here from multi branches in this
thread...

this is off the cuff.. no testing.

do you mean that
a: the selection is incorrect
or
b: that the 'areas' are only 'jumbled'

this seems due to fact that any union or intersect is
build from the
ACTIVEcell forwards.. and wraps around at the end.. first
selected
cell..alas afaik no easy way to recreate/reorder
a 'hashed' multiarea :(

(hence the threads' title?)

'============================
re other thread Square():
'============================
Peter.. be careful there..

i'had already done some speedtesting.
looping may not look cool.
and all the variables may not look cool either..

you CANNOT depend on the SEQUENCE of multiareas.
using entirerow/column definitely slows it down.

Function rRect2(rng As Range) As Range
Set rRect2 = Intersect(rng.EntireColumn, rng.EntireRow)
End Function


'================================
Re How's this for methodology..
'================================
Significant speed improvement if following change is made
to
prevent (slow) reunions when either multia is 4096.
(disproportionate etc :)


change THIS

Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192
Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

to THIS:
Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count m \ 2
Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT


i've got the feeling we'll be back :)


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


Peter T wrote :

Hi KeepITCool

Hope you don't mind my squeezing into your thread.
Really like the CF alternative, gives extra
possibilities.

A couple of things with the DV collection if "Goto
useDV".
Similar as I mentioned to Norman, in xl97 would need to
change:

With itm(0).Validation
.Add itm(1), itm(2), itm(3), itm(4), itm(5)
to
.Add itm(1), Abs(itm(2)), itm(3), itm(4), itm(5)

The DV Collection correctly replaces, but when doing
this:

ActiveCell.SpecialCells(xlCellTypeAllValidation).S elect

I get a perfect jigsaw of areas, rather than the single
area of DV I had originally applied over everything.
Using
the array method, when done I end up with the original
single area of DV.

Regards,
Peter



Function Inverse(rngA As Range, Optional bUsedRange
As
Boolean, _
'code

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

'code

End Function


.

Hi KeepItCool,

Piicking up the verbal skirmish from the third party thread,

You alluded to probleme distinguishing between a a MA 8182+ rogue aingle
area and a legitimate single area. I responded with lazy pseudo code:

I suggested (in lazy pseudo code)

If AreasCount = 1 and If CountBlanks(Area) Then = Bug Area

You responded:

ouch.. that wont do.. think about following:
what if my rngA was specialcells(numbers)
or just a manual selection.. nah.. wont do.. :(

Ok, enlighten me as to where the following falls down - I just code-jotted
the principle, which is that a legitimate single area will have no blank
cells, whilst an 8192 bug area will have many:

Sub Detect8192Areas()
Dim Rng As Range
Dim WS As Worksheet
Set WS = Sheets.Add

WS.Range("A1") = 100 ' CVErr(xlErrNA)


Set Rng = WS.Range("A1").Resize(2)
Range("A1:A2").AutoFill Destination:=Range("A1:a16500"), _
Type:=xlFillDefault

With WS.Columns(1)
With .SpecialCells(xlConstants, xlNumbers)
Debug.Print .Areas.Count & vbTab & _
Application.CountBlank(Range(.Address))
If .Areas.Count = 1 And _
Application.CountBlank(Range(.Address)) Then
MsgBox " This range has more " & _
"than 8192 non-contiguous areas!"
End If
End With
End With

End Sub

---
Regards,
Norman

"keepITcool" wrote in message
...

Norman..

How's this for methodology?
Presuming a selection cannot have more areas than 50% of cells...
This will return a collection of ranges..
Probably should be classed .. but goes to show the idea.

Done some basic testing but even at a:z60000 with 40% random non
blanks.. returned 48 multiarea ranges(avg 7500 areas/range)in the
collection. 90secs.. (1200k cells..372k areas.. but NO errors !

so far so good :)



Function SegmentedCells(rngA As Range, scType As XlCellType, _
Optional scValue As XlSpecialCellsValue) As Collection

Const m = 8192
Dim r&, l&, s&, rngT As Range, colRaw As Collection

Set colRaw = New Collection
Set SegmentedCells = New Collection

With rngA
If .Areas.Count 1 Then
Err.Raise vbObjectError + 1, , "No MultiArea as input."
Exit Function
End If
s = (m * 2 \ .Columns.Count)
l = s
If scValue = 0 Then
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType)
Next
Else
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType, _
scValue)
Next
End If
End With


Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192 Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

End Function


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


Norman Jones wrote :

I agree, however, that for present purposes at least, this is
academic as: (1) there is a limit (be it at 8192 or, sometimes,
slightly less) (2) processing time increases disproportionately
above (say) 4500 areas

It clearly is both necessary and expedient to segment the ranges. The
methodology for this is something that I am lookong at now.

---
Regards,
Norman

You alluded to probleme distinguishing between a a MA 8182+ rogue aingle
area and a legitimate single area. I responded with lazy pseudo code:

Let me try to re-type that phrase with a modicum of comprehensibility:

You alluded to problems in distinguishing between a rogue 8192+ MS
SpecialCells area and a legitimate single-area range. I responded with lazy
pseudo code

---
Regards,
Norman


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

Piicking up the verbal skirmish from the third party thread ...

Norman
of course your code works IF the preamble is that we're trying to
'invert' a range where the 'selection criteria' is clear

The problem is INSIDE the 'invert' function we're just presented with a
multiarea range....

The function doesn't know HOW that multiarea was built. and IF it has
any identifying traits to test on.

THUS your checker method must reside in the caller procedure.

or am i missing something :)




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


Norman Jones wrote :

Hi KeepItCool,

Piicking up the verbal skirmish from the third party thread,

You alluded to probleme distinguishing between a a MA 8182+ rogue
aingle area and a legitimate single area. I responded with lazy
pseudo code:

I suggested (in lazy pseudo code)

If AreasCount = 1 and If CountBlanks(Area) Then = Bug Area

You responded:

ouch.. that wont do.. think about following:
what if my rngA was specialcells(numbers)
or just a manual selection.. nah.. wont do.. :(

Ok, enlighten me as to where the following falls down - I just
code-jotted the principle, which is that a legitimate single area
will have no blank cells, whilst an 8192 bug area will have many:

Sub Detect8192Areas()
Dim Rng As Range
Dim WS As Worksheet
Set WS = Sheets.Add

WS.Range("A1") = 100 ' CVErr(xlErrNA)


Set Rng = WS.Range("A1").Resize(2)
Range("A1:A2").AutoFill Destination:=Range("A1:a16500"), _
Type:=xlFillDefault

With WS.Columns(1)
With .SpecialCells(xlConstants, xlNumbers)
Debug.Print .Areas.Count & vbTab & _
Application.CountBlank(Range(.Address))
If .Areas.Count = 1 And _
Application.CountBlank(Range(.Address)) Then
MsgBox " This range has more " & _
"than 8192 non-contiguous areas!"
End If
End With
End With

End Sub

---
Regards,
Norman

"keepITcool" wrote in message
...

Norman..

How's this for methodology?
Presuming a selection cannot have more areas than 50% of cells...
This will return a collection of ranges..
Probably should be classed .. but goes to show the idea.

Done some basic testing but even at a:z60000 with 40% random non
blanks.. returned 48 multiarea ranges(avg 7500 areas/range)in the
collection. 90secs.. (1200k cells..372k areas.. but NO errors !

so far so good :)



Function SegmentedCells(rngA As Range, scType As XlCellType, _
Optional scValue As XlSpecialCellsValue) As Collection

Const m = 8192
Dim r&, l&, s&, rngT As Range, colRaw As Collection

Set colRaw = New Collection
Set SegmentedCells = New Collection

With rngA
If .Areas.Count 1 Then
Err.Raise vbObjectError + 1, , "No MultiArea as input."
Exit Function
End If
s = (m * 2 \ .Columns.Count)
l = s
If scValue = 0 Then
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType)
Next
Else
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType, _
scValue)
Next
End If
End With


Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192 Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

End Function


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


Norman Jones wrote :

I agree, however, that for present purposes at least, this is
academic as: (1) there is a limit (be it at 8192 or,
sometimes, slightly less) (2) processing time increases
disproportionately above (say) 4500 areas

It clearly is both necessary and expedient to segment the ranges.
The methodology for this is something that I am lookong at now.

---
Regards,
Norman

I think i'm on the way with..
... needs some testing but it makes sense ..
... until it bugs out elsewhere..

'pseudo..
If rngResult.areas.count1 then
Set Inverse=rngResult
else
on error resume next
lCnt=intersect(rngA,rngResult).count
on error goto 0
if lcnt=0 then
Set InVerse = rngResult
else
Inverse=cverr(xlErrRef)
endif
endif


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


Norman Jones wrote :

Hi KeepItCool,

Piicking up the verbal skirmish from the third party thread,

You alluded to probleme distinguishing between a a MA 8182+ rogue
aingle area and a legitimate single area. I responded with lazy
pseudo code:

Hi KeepITcool,

No disagreement after all! I misunderstood the context of your remark:

offTopic to Norman.

still working on the 'final' inverse/notrange/complement..

my solution re 8192 bug
iso actually handling it inside the function i decided to
just go into 'error' mode when the inversed area count = 1
although THAT may be a valid situation.. :(
so now i got to work on that..arghhh

<g <<


---
Regards,
Norman



"keepITcool" wrote in message
...

Norman
of course your code works IF the preamble is that we're trying to
'invert' a range where the 'selection criteria' is clear

The problem is INSIDE the 'invert' function we're just presented with a
multiarea range....

The function doesn't know HOW that multiarea was built. and IF it has
any identifying traits to test on.

THUS your checker method must reside in the caller procedure.

or am i missing something :)




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


Norman Jones wrote :

Hi KeepItCool,

Piicking up the verbal skirmish from the third party thread,

You alluded to probleme distinguishing between a a MA 8182+ rogue
aingle area and a legitimate single area. I responded with lazy
pseudo code:

I suggested (in lazy pseudo code)

If AreasCount = 1 and If CountBlanks(Area) Then = Bug Area

You responded:

ouch.. that wont do.. think about following:
what if my rngA was specialcells(numbers)
or just a manual selection.. nah.. wont do.. :(

Ok, enlighten me as to where the following falls down - I just
code-jotted the principle, which is that a legitimate single area
will have no blank cells, whilst an 8192 bug area will have many:

Sub Detect8192Areas()
Dim Rng As Range
Dim WS As Worksheet
Set WS = Sheets.Add

WS.Range("A1") = 100 ' CVErr(xlErrNA)


Set Rng = WS.Range("A1").Resize(2)
Range("A1:A2").AutoFill Destination:=Range("A1:a16500"), _
Type:=xlFillDefault

With WS.Columns(1)
With .SpecialCells(xlConstants, xlNumbers)
Debug.Print .Areas.Count & vbTab & _
Application.CountBlank(Range(.Address))
If .Areas.Count = 1 And _
Application.CountBlank(Range(.Address)) Then
MsgBox " This range has more " & _
"than 8192 non-contiguous areas!"
End If
End With
End With

End Sub

---
Regards,
Norman

"keepITcool" wrote in message
...

Norman..

How's this for methodology?
Presuming a selection cannot have more areas than 50% of cells...
This will return a collection of ranges..
Probably should be classed .. but goes to show the idea.

Done some basic testing but even at a:z60000 with 40% random non
blanks.. returned 48 multiarea ranges(avg 7500 areas/range)in the
collection. 90secs.. (1200k cells..372k areas.. but NO errors !

so far so good :)



Function SegmentedCells(rngA As Range, scType As XlCellType, _
Optional scValue As XlSpecialCellsValue) As Collection

Const m = 8192
Dim r&, l&, s&, rngT As Range, colRaw As Collection

Set colRaw = New Collection
Set SegmentedCells = New Collection

With rngA
If .Areas.Count 1 Then
Err.Raise vbObjectError + 1, , "No MultiArea as input."
Exit Function
End If
s = (m * 2 \ .Columns.Count)
l = s
If scValue = 0 Then
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType)
Next
Else
For r = 1 To .Rows.Count Step s
If r + s .Rows.Count Then l = .Rows.Count - r + 1
colRaw.Add .Resize(l).Offset(r - 1).SpecialCells(scType, _
scValue)
Next
End If
End With


Set rngT = colRaw(1)
For r = 2 To colRaw.Count
If rngT.Areas.Count + colRaw(r).Areas.Count 8192 Then
SegmentedCells.Add rngT
Set rngT = colRaw(r)
Else
Set rngT = Union(rngT, colRaw(r))
End If
Next
SegmentedCells.Add rngT

End Function


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


Norman Jones wrote :

I agree, however, that for present purposes at least, this is
academic as: (1) there is a limit (be it at 8192 or,
sometimes, slightly less) (2) processing time increases
disproportionately above (say) 4500 areas

It clearly is both necessary and expedient to segment the ranges.
The methodology for this is something that I am lookong at now.

---
Regards,
Norman

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]

Norman,

For discussion: this is my current Procedure..
I'm gonna check on Thomas Ramel's code posted a few mins ago..



Function Invert(rngA As Range, Optional bUsedRange As Boolean, _
Optional rngB As Range) As Variant
' Author keepITcool

' Adapted from Norman Jones 2004 Jul 22 'Invert Selection
' Adapted from thread 2003 Oct 12 'Don't Intersect
' thread contributors Tom Ogilvy, Dave Peterson, Dana DeLouis
Dim lCnt&, cVal As Collection, vItm As Variant
Dim rUni As Range, rInt As Range, rRes As Range
Dim iEvt%, iScr%

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

Set cVal = New Collection

If rngB Is Nothing Then
If bUsedRange Then
Set rngB = rngA.Parent.UsedRange
Else
Set rngB = Square(rngA)
End If
End If

'2707: change to prevent inverting solid
' : 1st errtrap if rngA was passed via SpCells
On Error GoTo theErrors
Set rInt = Intersect(rngA, rngB)
If rInt.Areas.Count = 1 Then Err.Raise vbObjectError + 1
Set rUni = Union(rngA, rngB)


With rUni
On Error Resume Next
lCnt = rUni.SpecialCells(xlCellTypeAllFormatConditions).A reas.Count
On Error GoTo theErrors

If lCnt = 0 Then
'No existing Format conditions..
rUni.FormatConditions.Add 1, 3, 0
Intersect(rngA, rngB).FormatConditions.Delete
Set rRes = .SpecialCells(xlCellTypeAllFormatConditions)
rRes.FormatConditions.Delete

Else
Do
'Loop thru existing Validations
'Recurse Samevalidation store in cVal
On Error Resume Next
lCnt = 0
lCnt = .SpecialCells(xlCellTypeAllValidation).Count
On Error GoTo theErrors
If lCnt = 0 Then Exit Do
With Intersect(rUni, _
rUni.SpecialCells(xlCellTypeAllValidation) _
.Cells(1).SpecialCells(xlCellTypeSameValidation))

With .Validation
'Note this is not bulletproof.. needs more testing
cVal.Add Array(.Parent, _
.Type, .AlertStyle, .Operator, .Formula1,
..Formula2, _
.IgnoreBlank, .InCellDropdown, _
.ShowError, .ErrorTitle, .ErrorMessage, _
.ShowInput, .InputTitle, .InputMessage)
.Delete
End With
End With
Loop

'This is what we came for..
.Validation.Add 0, 1
Intersect(rngA, rngB).Validation.Delete
Set rRes = .SpecialCells(xlCellTypeAllValidation)
rRes.Validation.Delete

'Restore original validations
If cVal.Count 0 Then
For Each vItm In cVal
With vItm(0).Validation
.Add vItm(1), Abs(vItm(2)), vItm(3), vItm(4), vItm(5)
.IgnoreBlank = vItm(6)
.InCellDropdown = vItm(7)
.ShowError = vItm(8)
.ErrorTitle = vItm(9)
.ErrorMessage = vItm(10)
.ShowInput = vItm(11)
.InputTitle = vItm(12)
.InputMessage = vItm(13)
End With
Next
End If
End If
End With



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

If ObjPtr(rRes) 0 Then
If rRes.Areas.Count 1 Then
Set Invert = rRes
Else
On Error Resume Next
lCnt = Intersect(rngA, rRes).Areas.Count
On Error GoTo theErrors
If lCnt = 0 Then
Set Invert = rRes
Else
Set rRes = Nothing
Err.Raise vbObjectError + 2
GoTo theErrors
End If
End If
End If
Exit Function

theErrors:
Select Case Err.Number
Case vbObjectError + 1: vItm = "Solid input range. Cannot invert."
Case vbObjectError + 2: vItm = "Complex result range. Cannot invert."
Case Else: vItm = Err.Description
End Select
Invert = CVErr(xlErrRef)
MsgBox vItm, vbCritical, "Error:Inverse Function"
Resume theExit


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



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


Norman Jones wrote :

Hi KeepItCool,

Piicking up the verbal skirmish from the third party thread,

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

Hi KeepITcool,

I've been warming more and more to your DV Collection idea
when CF is not an option. The only reservation I have
remains replacing "jumbled" areas of validation (albeit
with correct DV).

What would you think of this as a minor adaption of your
Invert function:
Instead of storing / replacing DV in "rUni", first do -
Set rSqUni = Square(rUni)
and store / replace DV in rSqUni

Would speed be:
A: slower due to the extra use of the Square function and
quantity of DV in the larger range,
or
B: quicker because "probably" there would be a smaller
number of areas of DV in the square range,
or
C: depends?

With very limited testing I seem to end up with original
DV area(s).

Regards,
Peter

-----Original Message-----


Function Invert(rngA As Range, Optional bUsedRange As
Boolean, _
Optional rngB As Range) As Variant
' Author keepITcool

' Adapted from Norman Jones 2004 Jul 22 'Invert
Selection
' Adapted from thread 2003 Oct 12 'Don't Intersect
' thread contributors Tom Ogilvy, Dave Peterson, Dana
DeLouis
Dim lCnt&, cVal As Collection, vItm As Variant
Dim rUni As Range, rInt As Range, rRes As Range
Dim iEvt%, iScr%

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

Set cVal = New Collection

If rngB Is Nothing Then
If bUsedRange Then
Set rngB = rngA.Parent.UsedRange
Else
Set rngB = Square(rngA)
End If
End If

'2707: change to prevent inverting solid
' : 1st errtrap if rngA was passed via SpCells
On Error GoTo theErrors
Set rInt = Intersect(rngA, rngB)
If rInt.Areas.Count = 1 Then Err.Raise vbObjectError + 1
Set rUni = Union(rngA, rngB)


With rUni
On Error Resume Next
lCnt = rUni.SpecialCells
(xlCellTypeAllFormatConditions).Areas.Count
On Error GoTo theErrors

If lCnt = 0 Then
'No existing Format conditions..
rUni.FormatConditions.Add 1, 3, 0
Intersect(rngA, rngB).FormatConditions.Delete
Set rRes = .SpecialCells
(xlCellTypeAllFormatConditions)
rRes.FormatConditions.Delete

Else
Do
'Loop thru existing Validations
'Recurse Samevalidation store in cVal
On Error Resume Next
lCnt = 0
lCnt = .SpecialCells
(xlCellTypeAllValidation).Count
On Error GoTo theErrors
If lCnt = 0 Then Exit Do
With Intersect(rUni, _
rUni.SpecialCells
(xlCellTypeAllValidation) _
.Cells(1).SpecialCells
(xlCellTypeSameValidation))

With .Validation
'Note this is not bulletproof.. needs more
testing
cVal.Add Array(.Parent, _
.Type, .AlertStyle, .Operator,
..Formula1,
..Formula2, _
.IgnoreBlank, .InCellDropdown,
_
.ShowError, .ErrorTitle, .Error
Message, _
.ShowInput, .InputTitle, .Input
Message)
.Delete
End With
End With
Loop

'This is what we came for..
.Validation.Add 0, 1
Intersect(rngA, rngB).Validation.Delete
Set rRes = .SpecialCells(xlCellTypeAllValidation)
rRes.Validation.Delete

'Restore original validations
If cVal.Count 0 Then
For Each vItm In cVal
With vItm(0).Validation
.Add vItm(1), Abs(vItm(2)), vItm(3), vItm(4),
vItm(5)
.IgnoreBlank = vItm(6)
.InCellDropdown = vItm(7)
.ShowError = vItm(8)
.ErrorTitle = vItm(9)
.ErrorMessage = vItm(10)
.ShowInput = vItm(11)
.InputTitle = vItm(12)
.InputMessage = vItm(13)
End With
Next
End If
End If
End With



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

If ObjPtr(rRes) 0 Then
If rRes.Areas.Count 1 Then
Set Invert = rRes
Else
On Error Resume Next
lCnt = Intersect(rngA, rRes).Areas.Count
On Error GoTo theErrors
If lCnt = 0 Then
Set Invert = rRes
Else
Set rRes = Nothing
Err.Raise vbObjectError + 2
GoTo theErrors
End If
End If
End If
Exit Function

theErrors:
Select Case Err.Number
Case vbObjectError + 1: vItm = "Solid input range.
Cannot invert."
Case vbObjectError + 2: vItm = "Complex result range.
Cannot invert."
Case Else: vItm = Err.Description
End Select
Invert = CVErr(xlErrRef)
MsgBox vItm, vbCritical, "Error:Inverse Function"
Resume theExit


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

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]

Peter..

Thx for helping me here :)

I didnt see where your 'Jumbling Protest' came from,
since I'm only testing with a PURE invert (sans RngB)
and haven't tested on a 'Complement' style inversion.


To keep efficiency..

I changed as follows:

'added
dim rSqu as range

....In the beginning..

If rngB Is Nothing Then
If bUsedRange Then
Set rngB = rngA.Parent.UsedRange
Else
Set rngB = Square(rngA)
End If
'ADD THIS LINE
Set rSqu = rngB
End If


....Then IN THE ELSE part..

Else
'2707b added SquareUnion
If ObjPtr(rSqu) = 0 Then Set rSqu = Square(rUni)

Do
'StoreDV (recurse samevalidation,store in collection)
On Error Resume Next
lCnt = 0
lCnt = .SpecialCells(xlCellTypeAllValidation).Count
On Error GoTo theErrors
If lCnt = 0 Then Exit Do
With Intersect(rSqu, rSqu _
.SpecialCells(xlCellTypeAllValidation) _
.Cells(1).SpecialCells(xlCellTypeSameValidation))

With .Validation
'2707b..probs gone? when dv add changed to 3
cVal.Add Array(.Parent, _
.Type, .AlertStyle, .Operator, .Formula1,
..Formula2, _
.IgnoreBlank, .InCellDropdown, _
.ShowError, .ErrorTitle, .ErrorMessage, _
.ShowInput, .InputTitle, .InputMessage)
.Delete
End With
End With
Loop

'This is what we came for..
'2707b changed added validation
.Validation.Add 0, 3, , 0
Intersect(rngA, rngB).Validation.Delete
Set rRes = .SpecialCells(xlCellTypeAllValidation)
rRes.Validation.Delete

'Restore original validations


....rest unchanged





I must admit though.. I have a very nasty testfile..
(basically an alternating /1/blank)
with left and right DVs and FCs dropped in..

Following HAS happened:
due to editing or while testing I apparently damaged/copied not removed
some dummy validation






and it has bogged somewhere in the collectDV Do/Loop
but this may be due to the fact that the DalataValidation was
"damaged ?" BEFORE i ran the sub.


when I called it with rngA set to:
union([a:a5000].SpC(blanks),[a10000:a15000].Spc(blanks))


it READ a range where all Properties in the SameValidation range
indicating <appl defined errors so perhaps that indicates
a doevents is needed to give Excel time to recalc the tree ???
i assume SpeciallCells works on an cached index..




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


Peter T wrote :

Hi KeepITcool,

I've been warming more and more to your DV Collection idea
when CF is not an option. The only reservation I have
remains replacing "jumbled" areas of validation (albeit
with correct DV).

What would you think of this as a minor adaption of your
Invert function:
Instead of storing / replacing DV in "rUni", first do -
Set rSqUni = Square(rUni)
and store / replace DV in rSqUni

Would speed be:
A: slower due to the extra use of the Square function and
quantity of DV in the larger range,
or
B: quicker because "probably" there would be a smaller
number of areas of DV in the square range,
or
C: depends?

With very limited testing I seem to end up with original
DV area(s).

Regards,
Peter

KeepITcool,

I didnt see where your 'Jumbling Protest' came from,
since I'm only testing with a PURE invert (sans RngB)
and haven't tested on a 'Complement' style inversion.

Hardly a protest!
At most it's a trivial issue. Indeed for you it probably
won't arise as you are only going for the "Invert", the
title of this thread. However this code has bigger
possibilities - potentially will work well for subtracting
any intersecting ranges where either or both are
multiarea.

The basic principle has been discussed several times in
this NG (notably Dana DeLouis), but I think this is
working towards the best overall implementation, including
a lot of stuff I've done myself (not posted). Downside -
I'm going to have to re-work of my old code (:

So, I'm using avec un multi RngB - and getting un mélange
(with the Collection but not Array). I think using the
square will clear this up.

I'm currently having some problems with latest amendment
2707b and rSqu, Need to ensure all DV is collected from
the square range, then entirely deleted in the Square, do
stuff, then DV restored to the Square. Probably me missing
something obvious.


Following HAS happened:
due to editing or while testing I apparently
damaged/copied not removed
some dummy validation

Funny you should mention that. I've experienced similar
but ignored. Here's something else:

I have a recorded macro to replace identical DV to a
single area over everything before testing. But
occasionally it errors and I need to run the
line ".Delete" (DV) twice. I've got a feeling similar has
occurred in proper code without my knowing. I'm only
testing with small ranges - visible on the screen,
shouldn't need DoEvents.

If you can re-produce your "HAS", try adding a
second .Delete line before applying any DV.

Regards,
Peter