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
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