Select Non Contigouos Ranges

[LuisE]

I need to select all the cells underneath a "found" cell in column A and then
also the corresponding cells four columns to the right.

Here is what I have, it selects the entire range including columns in
between and an "Object Required" error.

Dim FoundDate As Range
Set FoundDate = Columns("A:A").Find(What:="Date", After:=ActiveCell,
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= False, SearchFormat:=False) '.Activate

Union(Range(FoundDate.Offset(1, 0), Selection.End(xlDown)).Select,
Range(FoundDate.Offset(0, 4), Selection.End(xlDown)).Select).Copy


I also struggle to understand set, object required dilema, any reference in
plain English?

Thanks in advance

 

[Bob Phillips]

Range(FoundDate.Offset(1, 0), FoundDate.End(xlDown)).Resize(,2).Select

 

[Mike H]

Maybe this

Sub standard()
Dim rFoundCell As Range
Set rFoundCell = Range("A1")
Set rFoundCell = Columns(1).Find(What:="DATE", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
myrange = Range(rFoundCell.Address).Resize(65537 - rFoundCell.Row, 5).Copy
End Sub

 

[Barb Reinhardt]

I believe this is what you are looking for

Sub Test()
Dim aWS As Worksheet
Dim FoundDate As Range
Dim lRow as long

Set aWS = ActiveSheet
Set FoundDate = Nothing
On Error Resume Next
Set FoundDate = aWS.Columns("A:A").Find(What:="Date", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If FoundDate Is Nothing Then
MsgBox ("Nothing found")
Exit Sub
End If

lrow = FoundDate.End(xlDown).Row

Set FoundDate = FoundDate.Resize(lrow - FoundDate.Row + 1, 1)
Debug.Print FoundDate.Address

Set FoundDate = Union(FoundDate, FoundDate.Offset(0, 4)) 'Change offset as
needed

Debug.Print FoundDate.Address


End Sub

 

[Rick Rothstein \(MVP - VB\)]

I think this does what you want...

Dim FoundDate As Range
Set FoundDate = Columns("A").Find(What:="Date", After:=ActiveCell, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
LookAt:=xlPart, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1, 0)
With FoundDate
Union(.Resize(.End(xlDown).Row - .Row + 1), _
.Resize(.End(xlDown).Row - .Row + 1).Offset(, 4)).Select
End With

Rick

 

[LuisE]

I'm sorry I misformulated my question.
I want those cells from Columns A and E and ignore the ones in between.

 

[LuisE]

I'm sorry I misformulated my question.
I want those cells from Columns A and E and ignore the ones in between.

 

[Rick Rothstein \(MVP - VB\)]

In what way does the code I posted not do what you want?

Rick

 

[Mike H]

to copy columns A & E try

Sub standard()
Dim rFoundCell As Range
Dim myrange As Range
Dim myrange1 As Range
Dim copyrange As Range

Set rFoundCell = Range("A1")
Set rFoundCell = Columns(1).Find(What:="DATE", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

Set myrange = Range(rFoundCell.Address).Resize(65537 - rFoundCell.Row, 1)
Set myrange1 = Range(rFoundCell.Address).Offset(, 4).Resize(65537 -
rFoundCell.Row, 1)
Set copyrange = Union(myrange, myrange1)
copyrange.Copy


End Sub

Mike

 

[Rick Rothstein \(MVP - VB\)]

I went with your Subject line, but in re-looking at your code, it appears
you don't need to select the range... your ultimate goal is to simply Copy
it. Change the .Select in the last code line (the Union statement) to .Copy
in order to do that.

Rick

 

[Bob Phillips]

Dim FoundDate As Range

Set FoundDate = Columns("A:A").Find(What:="Date", After:=ActiveCell,
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= False, SearchFormat:=False)
Set rng = Range(FoundDate.Offset(1, 0), FoundDate.End(xlDown))
Set rng = Union(rng, rng.Offset(0,4))
rng.Select

 

[LuisE]

Your code came after I posted the reply. It works just fine thanks a lot.

Thank you ALL