Excel email macro seems to be triggered whenever a cell is populated - vba

Question

I have a excel spreadsheet which tracks important dates, if you have missed an invoice for that date it will automatically send out an email to the relevant person reminding them to do so. The macro functions well and works off a trigger
`
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("2015").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("Q" & r).Value = "Received" Then
Call Macro1
End If
If Range("K" & r).Value = "Overdue" Then
Call email
End If
Next r
End Sub
`
Sub email()
Dim OutApp As Object
Dim OutMail As Object
Dim FName As String
Sheets("2015").Activate
For i = 1 To 100
If Sheets("2015").Range("K" & i).Value = "Overdue" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With OutMail
.To = Sheets("2015").Range("S" & i).Value
.CC = ""
.Subject = Sheets("2015").Range("B" & i).Value
.Body = "You have missed a valuation date for this project!"
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next i
End Sub
'
As you can see I am new to this so most of my code is from different examples on the internet. The problem I have is that when a cell in column K meets the requirements "Overdue" the macro will repeatedly email the user when a change in any other cell occurs. That is if K5 = "Overdue" and I go to A6 to enter a new user, the user in A5 will be emailed again. This happens for all cells until I change cell k5 to "sent".
I suspect part of the problem may also be in my e-mail macro...
I give up XD

Answer 1

Your macro's are working fine, I mean at least as you code them. You need to remove your macro's form FOR loops. What you can do is just getting the address of the changed cell and use it to define the mail address and subject. Something like below
** Worksheet macros**
Public mailAddress As String
Public TargetRow As Long
Public mailSubject
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "Overdue" Then
mailAddress = Sheets("2015").Range("S" & Target.Row)
mailSubject = Sheets("2015").Range("B" & Target.Row)
TargetRow = Target.Row
Call email
ElseIf Target.Value = "Received" Then
Call Macro1
End If
End Sub
And your macro should like something like this:
Sub email()
Dim OutApp As Object
Dim OutMail As Object
Dim FName As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With OutMail
.To = mailAddress
.CC = ""
.Subject = mailSubject
.Body = "You have missed a valuation date for this project!"
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Can you try and post answer here? I dont have excel right now, I could not try it.