With excellent help from Bernie Deitrick in response to my post "Can I do
this with arrays?" (
http://tinyurl.com/d2trc), I have found a method that
works for me.
I am trying to create a range that is all the cells in rng1 except the cells
in rng2. I iterated through all the cells of rng1, created a value from the
Row & Column of the cell, and read it into aryRng1. Repeated with rng2 and
aryRng2. Then, using Bernie's code, I removed all the values in ayrRng2
from aryRng1. Then I iterated through the revised aryRng1 and set a range
to .Cells(Left(aryRng1(x), Right(aryRng1(x)), using Union to add to the
range.
I don't know if this will stand up to all tests, or how fast it will be on
very large ranges (I'm working with less than 100 cells), but it does work
for me. I've posted the code for your reading pleasure.
Thank you, Walt, Tom, Norman and Bernie!
Ed
'*******************
Option Base 1
Sub TestSetRangeExcludingCells()
Dim aryRng1 As Variant 'cells of large range
Dim aryRng2 As Variant 'cells to be excluded
Dim rng1 As Range 'main range
Dim rng2 As Range 'range to be excluded
Dim rng3 As Range 'new range formed
Dim rngCl As Range 'temp range for cells
Dim x As Long, y As Long, z As Long
Dim a As Long, b As Long, c As Long
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = ActiveWorkbook
Set wks = wkb.Sheets("Sheet1")
Set rng1 = wks.Range("A1:E5")
Set rng2 = wks.Range("B1:B5")
x = rng1.Cells.Count
y = rng2.Cells.Count
' Read cell references from rng1 into array
ReDim aryRng1(1 To x) As Variant
c = 0
For Each rngCl In rng1
c = c + 1
aryRng1(c) = rngCl.Row & rngCl.Column
Next rngCl
' Read cell references from rng2 into array
ReDim aryRng2(1 To y) As Variant
c = 0
For Each rngCl In rng2
c = c + 1
aryRng2(c) = rngCl.Row & rngCl.Column
Next rngCl
' The following code is from Bernie Deitrick
' from the microsoft.public.excel.programming NG.
' It removes any value in aryRng2 from aryRng1.
' The result is all cell position references in rng1
' except those which also reference cells in rng2.
On Error Resume Next
For x = 1 To UBound(aryRng2)
aryRng1(Application.Match(aryRng2(x), aryRng1, False)) = ""
Next x
z = UBound(aryRng1)
For x = UBound(aryRng1) To 1 Step -1
If aryRng1(x) = "" Then
z = z - 1
For y = x To UBound(aryRng1) - 1
aryRng1(y) = aryRng1(y + 1)
Next y
End If
Next x
ReDim Preserve aryRng1(1 To z)
' Thank you, Bernie!
' Now set a range to the values of aryRng1
a = Left(aryRng1(1), 1)
b = Right(aryRng1(1), 1)
Set rng3 = wks.Cells(a, b)
For x = 1 To UBound(aryRng1)
a = Left(aryRng1(x), 1)
b = Right(aryRng1(x), 1)
Set rng3 = Union(rng3, wks.Cells(a, b))
Next x
rng3.Select
End Sub
"Walt" wrote in message
oups.com...
Hi Ed,
The following thread also deals with this subject, is shorter, and
possibly will give you something you feel you can use:
http://groups.google.com/group/micro...860f54a2f8e7fe
Walt Weber