Why are my 3 message boxes repeating twice?

[Ironman]

Hi

My 'Daily Tracking' worksheet has the following code:


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("EntRng")) Is Nothing Or Target.Count > 1 Then Exit Sub

' PROCEDURE 1
With Worksheets("Training Log")
MsgBox "Lifetime Mileage: " & Format$(.Range("E5").Value, "#,##0") & " " & vbNewLine & vbNewLine & _
"Year to Date Mileage: " & Format$(.Range("C5").Value, "#,##0") & " ", vbInformation, "Mileage Totals "
End With

' PROCEDURE 2
With Worksheets("Daily Tracking")
uValue = Sheets("Training Log").Range("MlsYTDLessLastYr")
Select Case uValue
Case Is < 0
utext = "less"
Case Is = 0
utext = "equal"
Case Is > 0
utext = "more"
End Select
MsgBox "You have now run " & uValue & " miles " & _
utext & " than this time last year ", vbInformation, "Mileage Compared To This Time Last Year"
End With

' PROCEDURE 3
If Range("CurYTD").Value > Range("CurGoal").Value Then
MsgBox ("Congratulations!" & vbNewLine & "You have now run more miles this year than" & vbNewLine & vbNewLine & _
"- The whole of " & Range("PreYear").Value & vbNewLine & _
"- " & Range("counter").Value & " of the " & Year(Now) - 1981 & " years you've been running" & vbNewLine & _
vbNewLine & "New rank for " & Year(Now) & " is " & Range("CurYTD").Offset(1, 0).Value & " out of " & Year(Now) - 1981), _
vbInformation, "Another Year End Mileage Total Exceeded "

Range("counter").Value = Range("Counter").Value + 1
Else
MsgBox (CLng(Range("CurGoal").Value - Range("CurYTD").Value) & _
" miles to go until you reach rank " & (Range("CurYTD").Offset(1, 0).Value) - 1 & " " & vbNewLine & vbNewLine & _
" (Year end mileage for " & Range("PreYear").Value & ")"), _
vbInformation, "Year To Date Mileage"
End If
End Sub


The 3 procedures named above run consecutively no problem, but after Procedure 3 has run, all 3 run one more time in sequence.

What do I need to add or amend so that the 3 procedures only run once?

Thanks

 

[Ironman]

Thanks Mike - I just tried that and it made no difference.

Edit: It did work. However, it still repeats as previously described when I double click any cell in the Daily Tracking sheet. I did a search for the words 'double' and 'click' and there were no entries found.

 

[MARK858]

What happens if you change

If Intersect(Target, Range("EntRng")) Is Nothing Or Target.Count > 1 Then Exit Sub

to

If Not Intersect(Target, Range("EntRng")) Is Nothing Then
If Target.Count > 1 Then Exit Sub

and put End If as the last line before End Sub.

 

[Ironman]

Hi Mark - didn't work, got the End If Without Block If error.

I've just noticed something - if I double click on an empty cell in the column it works perfectly. It seems to be related to cells with values in them.

 

[MARK858]

Hi Mark - didn't work, got the End If Without Block If error.

Did you put in the End If statement that I said in the the previous post?
If yes post the code as you had it.

 

[Ironman]

Strange - no error this time, even though I followed your suggestion exactly!

However, the issue still remains (but there's no repeating if I double click an empty cell)