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

 

[MARK858]

Do you get the same problem with the code below?

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("EntRng")) Is Nothing Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    ' 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

    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 "

        ' PROCEDURE 3
        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
    Application.EnableEvents = True
End Sub

 

[Ironman]

Hi Mark, many thanks.

Yes, inserting

Application.EnableEvents = False

at the start and

Application.EnableEvents = True

at the end as you suggested made no difference.

(I've just noticed your footer re Code Tags )

 

[MARK858]

And just to make sure, if you change

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

to

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

still the same?

 

[Ironman]

It's still the same.

 

[MARK858]

Not much that I can suggest without having the workbook to test on other than to suggest to put a break point at the start of the code (or the word Stop on a separate line) and then step through with F8 to try and see when the second run is called.

http://www.cpearson.com/excel/debuggingvba.aspx

 

[Ironman]

OK Mark, thanks.

 

[Ironman]

Here's the workbook link, if it's of any assistance?

https://www.dropbox.com/s/d0a7aj233gn35wp/Exercise%20Log.xlsm?dl=0

Many thanks

 

[mikerickson]

This line

Range("counter").Value = Range("Counter").Value + 1

is triggering a second change event.
you need to disable events before and re-enable them after

Application.EnableEvents = False
Range("counter").Value = Range("Counter").Value + 1
Application.EnableEvents = True

 

[Ironman]

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