Search code examples
vbarangetargetintersect

Reset/Reuse Target Range for Spreadsheet


I am attempting to write a macro that will send an email if a specific range is selected and meets certain criteria. I have several email subs that will be called depending upon which range is selected/activated. I'm trying to use the Intersect(Range, Target) method to restrict which range will call which email sub. The problem I'm having is that my code always defaults to the first range in the sheet, but I need it to just use the active range. I've included a sample of my code below.

Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub

'Checklist Setup Review
Dim LastRow As Long
Dim i As Long
Dim xRg As Range
Dim x As String
Dim NewRng As Range

LastRow = Cells(Rows.Count, "H").End(xlUp).Row
For i = 1 To LastRow
    If UCase(Cells(i, "H").Value) = "P" Then
        If NewRng Is Nothing Then
            Set NewRng = Cells(i, "A")
        Else
            Set NewRng = Union(NewRng, Cells(i, "A"))
        End If
    End If
Next i

'Initial Lidar Review
Dim LastRow1 As Long
Dim e As Long
Dim NewRng1 As Range

LastRow1 = Cells(Rows.Count, "I").End(xlUp).Row
For e = 1 To LastRow1
    If UCase(Cells(e, "I").Value) = "P" Then
        If NewRng1 Is Nothing Then
            Set NewRng1 = Cells(e, "A")
        Else
            Set NewRng1 = Union(NewRng1, Cells(e, "A"))
        End If
    End If
Next e

'Initial Ground Macro Review
Dim LastRow2 As Long
Dim xRg2 As Range
Dim j As Long
Dim NewRng2 As Range

LastRow2 = Cells(Rows.Count, "J").End(xlUp).Row
For j = 1 To LastRow2
    If UCase(Cells(j, "J").Value) = "P" Then
        If NewRng2 Is Nothing Then
            Set NewRng2 = Cells(j, "A")
        Else
            Set NewRng2 = Union(NewRng2, Cells(j, "A"))
        End If
    End If
Next j

'Call Email subs
If xRg Is Nothing Then
    Set xRg = Intersect(NewRng, Target)
    x = True
    For Each r In NewRng
        If r.Value <> "Pass" And r.Value <> "Complete" Then
            x = False
        End If
    Next r
    If x = True Then
        MsgBox "Project Setup Review Complete: Auto Email Sent."
        Call SetupReview_Email
    End If
ElseIf xRg Is Nothing Then
    Set xRg = Intersect(NewRng1, Target)
    If xRg Is Nothing Then Exit Sub
    x = True
    For Each r In NewRng1
        If r.Value <> "Pass" And r.Value <> "Complete" Then
            x = False
        End If
    Next r
    If x = True Then
        MsgBox "Intial Lidar Review Completed: Auto Email Sent."
        InitialLidarReview_Email
    End If
ElseIf xRg Is Nothing Then
    Set xRg = Intersect(NewRng2, Target)
    For Each r In NewRng2
        If r.Value <> "Pass" And r.Value <> "Complete" Then
            x = False
        End If
    Next r
    If x = True Then
        MsgBox "Ground Macro Review Completed: Auto Email Sent."
        Call GroundMacro_Email
    End If
End If

End Sub


Solution

  • Doing this slightly rushed but hopefully you get the gist. Should the If statements actually be checking if the Intersect is NOT Nothing?

    Set xRg = Intersect(NewRng, Target)
    If xRg Is Nothing Then
        'stuff
    Else
        Set xRg = Intersect(NewRng1, Target)
        If xRg Is Nothing Then
            'stuff
        Else
            Set xRg = Intersect(NewRng2, Target)
            If xRg Is Nothing Then
                'stuff
            End If
        End If
    End If