Does anyone how to exlude a range from the code as outlined below. I need to
have "P10:P24" show up as blank when a user hits the delete button. Thanks!



Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim myRng As Range
Set myRng = Me.Range("E10:AK24")
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRng).Cells

If myCell.Value = "" Then
myCell.Value = 0
End If
If Not Intersect(myCell, Me.Range("E10:M24")) Is Nothing Then
myCell.Value = Abs(myCell.Value)
End If
If Not Intersect(myCell, Me.Range("Q10:AH24")) Is Nothing Then
myCell.Value = -Abs(myCell.Value)
End If
Next myCell
Application.EnableEvents = True
End Sub

The easiest way to exclude a range is to build another range without it:

Sub range_exclude()
Dim r1 As Range, r2 As Range, rx As Range
Set r1 = Range("A1:Z100")
Set r2 = Range("P10:P24")

For Each r In r1
If Not Intersect(r, r2) Is Nothing Then
Else
If rx Is Nothing Then
Set rx = r
Else
Set rx = Union(rx, r)
End If
End If
Next
rx.Select
End Sub

Here we make rx from r1, but we exclude any cell in r2.
--
Gary''s Student


"Please help James" wrote:

Does anyone how to exlude a range from the code as outlined below. I need to
have "P10:P24" show up as blank when a user hits the delete button. Thanks!



Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim myRng As Range
Set myRng = Me.Range("E10:AK24")
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRng).Cells

If myCell.Value = "" Then
myCell.Value = 0
End If
If Not Intersect(myCell, Me.Range("E10:M24")) Is Nothing Then
myCell.Value = Abs(myCell.Value)
End If
If Not Intersect(myCell, Me.Range("Q10:AH24")) Is Nothing Then
myCell.Value = -Abs(myCell.Value)
End If
Next myCell
Application.EnableEvents = True
End Sub

Wouldn't you just test that range first

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim myRng As Range
Set myRng = Me.Range("E10:AK24")
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRng).Cells

If myCell.Value = "" Then
myCell.Value = 0
End If
If Not Intersect(myCell, Me.Range("E10:M24")) Is Nothing Then
myCell.Value = Abs(myCell.Value)
ElseIf Not Intersect(myCell, Me.Range("P10:P24")) Is Nothing Then

'do something in this case
ElseIf Not Intersect(myCell, Me.Range("Q10:AH24")) Is Nothing Then
myCell.Value = -Abs(myCell.Value)

End If
Next myCell

Application.EnableEvents = True
End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Please help James" wrote in
message ...
Does anyone how to exlude a range from the code as outlined below. I need
to
have "P10:P24" show up as blank when a user hits the delete button.
Thanks!



Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim myRng As Range
Set myRng = Me.Range("E10:AK24")
Application.EnableEvents = False
For Each myCell In Intersect(Target, myRng).Cells

If myCell.Value = "" Then
myCell.Value = 0
End If
If Not Intersect(myCell, Me.Range("E10:M24")) Is Nothing Then
myCell.Value = Abs(myCell.Value)
End If
If Not Intersect(myCell, Me.Range("Q10:AH24")) Is Nothing Then
myCell.Value = -Abs(myCell.Value)
End If
Next myCell
Application.EnableEvents = True
End Sub

Gary''s Student wrote...
The easiest way to exclude a range is to build another range without it:

Sub range_exclude()
Dim r1 As Range, r2 As Range, rx As Range
Set r1 = Range("A1:Z100")
Set r2 = Range("P10:P24")

For Each r In r1
If Not Intersect(r, r2) Is Nothing Then
Else
If rx Is Nothing Then
Set rx = r
Else
Set rx = Union(rx, r)
End If
End If
Next
rx.Select
End Sub

Brute force again. Given a larger single area range A and a smaller
single area range B entirely contained within A (possibly on one or
more edge of A), the complement of B in A is the union of no more than
4 other single area ranges. Needs more code, but runs much more quickly
on large ranges.


Sub foobar()
rc(Range("A1:Z100"), Range("P10:P24")).Select
End Sub


Function rc(a As Range, b As Range) As Range
Dim t As Range

'if b not contained in a, return Nothing
If Intersect(a, b).Cells.Count < b.Cells.Count Then Exit Function

If a.Column < b.Column Then
Set rc = Range(a.Cells(1, 1), _
a.Cells(a.Rows.Count, b.Column - a.Column))
End If

If a.Row < b.Row Then
Set t = Range(b.Cells(1, 1).Offset(-1, 0), _
a.Cells(1, a.Columns.Count))
If rc Is Nothing Then Set rc = t Else Set rc = Union(rc, t)
End If

If b.Column + b.Columns.Count < a.Column + a.Columns.Count Then
Set t = Range(b.Cells(1, b.Columns.Count).Offset(0, 1), _
a.Cells(a.Cells.Count))
If rc Is Nothing Then Set rc = t Else Set rc = Union(rc, t)
End If

If b.Row + b.Rows.Count < a.Row + a.Rows.Count Then
Set t = Range(a.Cells(a.Rows.Count, b.Column - a.Column + 1), _
b.Cells(b.Cells.Count).Offset(1, 0))
If rc Is Nothing Then Set rc = t Else Set rc = Union(rc, t)
End If

End Function

I once again yield to you on efficiency and imagination. I especially like
the test for the intersection being null at the beginning. It appears the
the only time the "brute force" approach is necessary is if either of the
ranges have disjoint cells.
--
Gary''s Student


"Harlan Grove" wrote:

Gary''s Student wrote...
The easiest way to exclude a range is to build another range without it:

Sub range_exclude()
Dim r1 As Range, r2 As Range, rx As Range
Set r1 = Range("A1:Z100")
Set r2 = Range("P10:P24")

For Each r In r1
If Not Intersect(r, r2) Is Nothing Then
Else
If rx Is Nothing Then
Set rx = r
Else
Set rx = Union(rx, r)
End If
End If
Next
rx.Select
End Sub

Brute force again. Given a larger single area range A and a smaller
single area range B entirely contained within A (possibly on one or
more edge of A), the complement of B in A is the union of no more than
4 other single area ranges. Needs more code, but runs much more quickly
on large ranges.


Sub foobar()
rc(Range("A1:Z100"), Range("P10:P24")).Select
End Sub


Function rc(a As Range, b As Range) As Range
Dim t As Range

'if b not contained in a, return Nothing
If Intersect(a, b).Cells.Count < b.Cells.Count Then Exit Function

If a.Column < b.Column Then
Set rc = Range(a.Cells(1, 1), _
a.Cells(a.Rows.Count, b.Column - a.Column))
End If

If a.Row < b.Row Then
Set t = Range(b.Cells(1, 1).Offset(-1, 0), _
a.Cells(1, a.Columns.Count))
If rc Is Nothing Then Set rc = t Else Set rc = Union(rc, t)
End If

If b.Column + b.Columns.Count < a.Column + a.Columns.Count Then
Set t = Range(b.Cells(1, b.Columns.Count).Offset(0, 1), _
a.Cells(a.Cells.Count))
If rc Is Nothing Then Set rc = t Else Set rc = Union(rc, t)
End If

If b.Row + b.Rows.Count < a.Row + a.Rows.Count Then
Set t = Range(a.Cells(a.Rows.Count, b.Column - a.Column + 1), _
b.Cells(b.Cells.Count).Offset(1, 0))
If rc Is Nothing Then Set rc = t Else Set rc = Union(rc, t)
End If

End Function

Gary''s Student wrote...
....
the only time the "brute force" approach is necessary is if either of the
ranges have disjoint cells.
....

No, you could iterate through all areas in each range A (larger) and B
(smaller).

First, you'd need to check that each area in B is contained in A as a
whole, so

state = True
For Each r In B.Areas
state = state And (Intersection(A, r).Cells.Count = r.Cells.Count)
Next r

Then you'd need to iterate through each area in A, then iterating
through each area in B, finding the complement of the intersection of
the current areas of A and B in the current area of A, taking the
intersection of the complements of all the areas in B in the current
area in A, then taking the union of all these intersections. Messy.

Set C = Nothing
For i = 1 To A.Areas.Count
Set D = Nothing
For j = 1 To B.Areas.Count
Set t = rc(A.Areas(i), Intersect(A.Areas(i), B.Areas(j))) '## my
earlier rc function ##
If Not t Is Nothing Then If D Is Nothing Then Set D = t Else Set D
= Intersection(D, t)
Next j
If Not D Is Nothing Then If C Is Nothing Then Set C = D Else Set C =
Union(C, D)
Next i

I thought this was overkill for the OP's problem. Also, this doesn't
ensure the areas in C are mutually disjoint. OK for clearing the
complement of B in A, but not OK for calculations.