Range is not accessible to Application.Intersect

Question

I cannot seems to access a VBA defined range ("DateRange") within Application.Intersect. Using Application.Intersect(DateRange,Cellref) gives the error "Object required" The range is able to be copied to another sheet and the address can also be retrieved via MsgBox DateRange.Address. Below is the code. This one has really got me scratching my head.

Sub FindCells2()

Dim LR As Long, i As Long
Dim Txt As String
Dim j, k As Integer
Dim StartDate, FinishDate As String
Dim Sh As Worksheet: Set Sh = Sheets("Full chart and primary cals")
Dim Cellref, DateRange As Range

'Find Date Range
'Search location and values
LookupColumn = "B"
'Enter date as YYYY.MM.DD HH:00
StartDate = "2013.01.02 20:00"
FinishDate = "2013.01.09 20:00"

With Sh
'Search for cells containing date strings
For j = 1 To 30000
    If Sh.Range(LookupColumn & j).Value = FinishDate Then FinishDateRow = j
    Next j
For k = FinishDateRow To 1 Step -1
    If Sh.Range(LookupColumn & k).Value = StartDate Then StartDateRow = k
    Next k
'Set DateRange as area between rows with Date strings
Set DateRange = Sh.Range("A" & StartDateRow & ":" & "Q" & FinishDateRow)
MsgBox DateRange.Address

'Find Cells
'Loop through sheet looking for cells
    LR = .Range("B" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        'Find cells in "M" and store thier reference in Cellref
        If .Range("M" & i).Value <= 25 Then Set Cellref = .Range("M" & i)
        'Find if Cell ref is contained within DateRange and store result as bool
        If Application.Intersect(DateRange, Cellref) Is Nothing Then MsgBox Intersect is Negative 
        'Output cell ranges to the appropriate sheets
        If iSect And Cellref.Cells(i, "M").Offset(0, -5) <= Cellref.Cells(i, "M").Offset(-10, -5) Then Cellref.Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("DownT").Range("A" & Rows.Count).End(xlUp).Offset(2)
        If iSect And Cellref.Cells(i, "M").Offset(0, -5) > Cellref.Cells(i, "M").Offset(-10, -5) Then Cellref.Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("UpT").Range("A" & Rows.Count).End(xlUp).Offset(2)
       'End With
    Next i
End With
End Sub

You should check whether Cellref is set to anything before trying to use it in `Intersect` — Tim Williams, Jul 05 '14 at 16:43
You'll also get an error if that statement evaluates to True, I think you intend `MsgBox "Intersect is Nothing"`, without qualifying that as a string, `Intersect Is Nothing` will raise an "Argument Not Optional" error and the code won't compile. — David Zemens, Jul 05 '14 at 18:33
Also note that you have not assigned any value to `iSect` (nor have you declared that variable...) so the next two statements will also be a problem for you. Also, if you're using `CellRef` in a loop, you should be setting it to `Nothing` (probably) at each iteration, otherwise it will retain the previous assignment, which may not be what you intend to do. — David Zemens, Jul 05 '14 at 18:36

score 0 · Accepted Answer · answered Jul 06 '14 at 00:53

Thank you ti David Zemens and Tim Williams for their suggestions. It turns out that Cellref does indeed need a value to allow any subsequent line to operate (as does iSect). These are VBA caveats I guess. I set Cellref to an arbitrary cell if the first conditino is not met and inserted the expected value for iSect in subsequent conditions. The code now works as expected.

Again, thank you for your help.

'Find Cells
    'Loop through sheet looking for cells
        LR = .Range("B" & Rows.Count).End(xlUp).Row
        For i = 10 To LR
            'Find cells in "M" and store thier reference in Cellref
            If .Range("M" & i).Value <= 25 Then Set Cellref = .Range("M" & i) Else Set Cellref = .Range("Z15")
            'Find if Cell ref is contained within DateRange and store result as bool
            If Not Application.Intersect(DateRange, Cellref) Is Nothing Then iSect = True Else iSect = False
            'Output cell ranges to the appropriate sheets
            If iSect = True And Cellref.Offset(0, -5) < Cellref.Offset(-10, -5) Then _
            Cellref.Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("DownT").Range("A" & Rows.Count).End(xlUp).Offset(2)
            If iSect = True And Cellref.Offset(0, -5) > Cellref.Offset(-10, -5) Then _
            Cellref.Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("UpT").Range("A" & Rows.Count).End(xlUp).Offset(2)
           'End With
        Next i
    End With

Range is not accessible to Application.Intersect

1 Answers1