Untitled

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim threshold As Double
    
    ' Define the target cell (A12) and the threshold value (70%)
    Set rng = Me.Range("A12")
    threshold = 0.7
    
    ' Check if the changed cell is A12
    If Not Intersect(Target, rng) Is Nothing Then
        ' Check if the new value exceeds the threshold
        If Target.Value > threshold Then
            ' Display a message box with the option to send an email
            If MsgBox("Cell A12 has reached " & Format(Target.Value, "0%") & ". Send an email?", vbYesNo) = vbYes Then
                ' Customize your email details here
                Dim recipient As String
                Dim subject As String
                Dim body As String
                
                recipient = "recipient@example.com"
                subject = "Threshold reached in cell A12"
                body = "The value in cell A12 has exceeded 70%."
                
                ' Create and send the email
                Call SendEmail(recipient, subject, body)
            End If
        End If
    End If
End Sub

Sub SendEmail(ByVal recipient As String, ByVal subject As String, ByVal body As String)
    ' Add your email sending logic here (e.g., using Outlook or other email clients)
    ' For demonstration purposes, I'll just display a message box.
    MsgBox "Email sent to " & recipient & vbCrLf & "Subject: " & subject & vbCrLf & "Body: " & body
End Sub