MSGBOX Hatası

[murathano]

Merhabalar

Aşağıdaki şekilde belirli bir bütçeyi aşınca çalışacak bir dosya hazırladım fakat saydir değişkeni içerisinde yer alan hücrelerden birisi dışında değişiklik yapılıp bütçe durumu aşılınca msgbox yüzlerce kez tekrar ediyor bunun önüne nasıl geçebilirim destek olabilir misiniz?
Private Sub Worksheet_Change(ByVal Target As Range)
saydir = Target.Value
saydir = Excel.WorksheetFunction.Sum(Sayfa2.Range("o111000")) + Excel.WorksheetFunction.Sum(Sayfa7.Range("bl12:bl1000")) + Excel.WorksheetFunction.Sum(Sayfa7.Range("bm12:bm1000")) + Excel.WorksheetFunction.Sum(Sayfa10.Range("bl12:bl1000")) + Excel.WorksheetFunction.Sum(Sayfa10.Range("bm12:bm1000")) + Excel.WorksheetFunction.Sum(Sayfa3.Range("o111000"))
If saydir > Sayfa1.Range("a6") Then
MsgBox "Bütçe Tahsisi Aşılmıştır"
Target.ClearContents
End If

End Sub

 

[muhasebeciyiz]

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> SaydirRange.Address Then Exit Sub
saydir = Target.Value
saydir = Excel.WorksheetFunction.Sum(Sayfa2.Range("o111000")) + Excel.WorksheetFunction.Sum(Sayfa7.Range("bl12:bl1000")) + Excel.WorksheetFunction.Sum(Sayfa7.Range("bm12:bm1000")) + Excel.WorksheetFunction.Sum(Sayfa10.Range("bl12:bl1000")) + Excel.WorksheetFunction.Sum(Sayfa10.Range("bm12:bm1000")) + Excel.WorksheetFunction.Sum(Sayfa3.Range("o111000"))

Dim bütçeAşıldı As Boolean
If bütçeAşıldı Then Exit Sub

If saydir > Sayfa1.Range("a6") Then

MsgBox "Bütçe Tahsisi Aşılmıştır"
bütçeAşıldı = True
End If
End Sub

Kontrol edermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitSub
Application.EnableEvents = False

Dim saydir As Double
saydir = Excel.WorksheetFunction.Sum(Sayfa2.Range("o111000")) + _
Excel.WorksheetFunction.Sum(Sayfa7.Range("bl12:bl1000")) + _
Excel.WorksheetFunction.Sum(Sayfa7.Range("bm12:bm1000")) + _
Excel.WorksheetFunction.Sum(Sayfa10.Range("bl12:bl1000")) + _
Excel.WorksheetFunction.Sum(Sayfa10.Range("bm12:bm1000")) + _
Excel.WorksheetFunction.Sum(Sayfa3.Range("o111000"))

If saydir > Sayfa1.Range("a6").Value Then
MsgBox "Bütçe Tahsisi Aşılmıştır"
Target.ClearContents
End If

ExitSub:
Application.EnableEvents = True
End Sub