Intersect, Union... where's Deduct?

[rumi]

Hi everybody!
I wonder if anyone knows how to deduct range from other range. You can
add ranges (Union method) or have their intersection (Intersect method)
but I didn't find a way to do something like I think it should be done
- Deduct(Range("A:A"),Range("A1:A2")) which would result with the range
A3:A65536.
Can anyone help?

[Bob Phillips]

'-----------------------------------------------------------------
Function DeductRange(SetRange As Range, UsedRange As Range) As Range
'-----------------------------------------------------------------
Dim saveSet
saveSet = SetRange.Formula
SetRange.ClearContents
UsedRange = 0
Set DeductRange = SetRange.SpecialCells(xlCellTypeBlanks)
SetRange = saveSet
End Function

Sub testIt()
MsgBox DeductRange(Range("A:A"), Range("A1:A2")).Address
End Sub

--
HTH

Bob Phillips

"rumi" <art...@poczta.onet.pl> wrote in message
news:1126627371.0...@g14g2000cwa.googlegroups.com...

[Jim May]

This is my favorite Personal.xls Macro
Highlite Area 1, Hold down Control key and
Highlite Area2, then run:

Sub Difference()
If Selection.Areas.Count > 2 Then
MsgBox "Only Two Areas can be Selected. Try Again"
Else
MsgBox "Difference is " & Format(Application.Sum(Selection.Areas(1))
- Application.Sum(Selection.Areas(2)), "#,###.00")
End If
End Sub

[Jim May]

Obviously, I can't read;
My suggestion was totally OFF COURSE!!
Jim

[Jim Thomlinson]

Very nice code, just one minor warning. You save the contents -> Delete the
contents -> Get your range -> then replace the contents. My issue is when you
replace the contents. (It is an uncommon error but it can happen). If you had
a cell formated as a number or general but populated with 1234 as a text
string, then when the contents are replaced Excel will do an implicit
conversion of the text and make it into a number.

That being said I am going to save this function for future use as it could
be really useful. Thanks Bob...
--
HTH...

Jim Thomlinson

[JE McGimpsey]

Note that this will give a run-time error if the activesheet is
unpopulated, or if nothing outside UsedRange is populated, i.e., if
UsedRange encompasses the Activesheet's used range. The OP also asked for

DeductRange(Range("A:A"), Range("A1:A2"))

to return A3:A65536 - in XL97 (IIRC) and MacXL, the macro only returns
cells in the used range.

It also gives a weird answer for this situation.

In a blank sheet, enter 1 in A1, 2 in A2.

Run

Public Sub testit()
MsgBox DeductRange(Range("A:A"), Range("A1:C1")).Address
End Sub

The MsgBox returns "$A$2"

This function isn't necessarily fast, but it will work in all versions:

Public Function DeductRange(rBase As Range, _
rDeduct As Range) As Range
Dim rIntersect As Range
Dim rCell As Range
Dim rBuild As Range
If rBase.Address = rDeduct.Address Then
Set DeductRange = Nothing
Else
Set rIntersect = Intersect(rBase, rDeduct)
If rIntersect Is Nothing Then
Set DeductRange = rBase
Else
For Each rCell In rBase
If Intersect(rCell, rDeduct) Is Nothing Then
If rBuild Is Nothing Then
Set rBuild = rCell
Else
Set rBuild = Union(rBuild, rCell)
End If
End If
Next rCell
Set DeductRange = rBuild
End If
End If
End Function

Since the OP gave only one-dimensional ranges, and so is a bit
ambiguous, this function may also be of interest as it returns the union
of all cells that aren't in the intersection of the two ranges:

Public Function AntiUnion(rng1 As Range, rng2 As Range) As Range
Dim rCell As Range
Dim rIntersect As Range
Dim rUnion As Range
Dim rBuild As Range
If rng1.Address = rng2.Address Then
Set AntiUnion = Nothing
Else
Set rUnion = Union(rng1, rng2)
Set rIntersect = Intersect(rng1, rng2)
If rIntersect Is Nothing Then
Set AntiUnion = rUnion
Else
For Each rCell In rUnion
If Intersect(rCell, rIntersect) Is Nothing Then
If rBuild Is Nothing Then
Set rBuild = rCell
Else
Set rBuild = Union(rBuild, rCell)
End If
End If
Next rCell
Set AntiUnion = rBuild
End If
End If
End Function

It could obviously be optimized for cells outside the used range, and it
could use some error checking to ensure that rng1 and rng2 are both on
the same worksheet.

In article <#RUz8AIu...@tk2msftngp13.phx.gbl>,

[Walt]

Hi,

I like Bob's response for use in certain cases. It's fast! But, it
depends in the fully overlapping primary and exclusion ranges
(Non-Overlapped Cells of the excluded range have their contents
replaced with Zeros). And, it depends on rectangular ranges (It's
part of the nature of array variants).

Then I was about to post something close to that by JE McGimpsey (I
didn't bother when I saw he beat me to it). But the speed penalty of
building the result range cell by cell troubled me.

The following does deal with the non-overlapping and non-contiguous
ranges and most of the speed penalty:

'***************************
Dim ADDR As String

Sub test2()
ActiveSheet.Range("A:A,C:C").Name = "Primary"
'Non-Contiguous
ActiveSheet.Range("A1:A2,C2:H7,J:K").Name = "Exclude"
'Non-Contiguous & Not Fully Overlapping
ADDR = ""
Call DeductRange("Primary", "Exclude")
If Not ADDR = "" Then
ActiveSheet.Range(ADDR).Select
Else
MsgBox "Ranges specified totally overlap each other"
End If
End Sub

Sub DeductRange(PRIM As String, EXCL As String)
'MIGHT WANT TO INCLUDE Application.EnableEvents = False
' AND Application.ScreenUpdating = False HERE

ActiveSheet.Copy 'CREATES TEMP WORKBOOK WITH THE NAMED RANGES

'Bob Phillips' BASIC MECHANISM HERE
ActiveSheet.Range(PRIM).ClearContents
ActiveSheet.Range(EXCL) = 0
ADDR =
ActiveSheet.Range(PRIM).SpecialCells(xlCellTypeBlanks).Address
'
ActiveWorkbook.Close savechanges:=False 'DELETES TEMP WORKBOOK

'AND MIGHT WANT TO INCLUDE Application.EnableEvents = True
' AND Application.ScreenUpdating = True HERE
End Sub

In using the temporary workbook, there's no need to be concerned about
corrupting the cell contents to help in identifying the range address.
And yes, some error handling should be included.

If this posted twice, I apologize. I'm having trouble with a dropped
connection.

'******************************************

Best Regards,
Walt

[Walt]

Hi,

'******************************************

Best Regards,
Walt