VBA code to send an email if a certain IF Criteria is met that loops when the spreadsheet is open

[joeyc123]

Hi,
How can i create a vba code where it gives me an email alert if in my Sheet called "Summary" in column H2 to H18, contains the word "MAJOR". Range H2 to H18 contains an if statement that changes by the minute as It is a real-time formula so i would like this code to automatically run every minute if the sheet is opened and send me a email alert? is that possible? i have this code but it doesnt seem to automatically run every minute, what do you think is wrong?

Sub CheckCriteria()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range


Set ws = ThisWorkbook.Sheets("Summary")
Set rng = ws.Range("H2:H18")


For Each cell In rng
' Check if the cell contains the word "MAJOR"
If InStr(1, cell.Value, "MAJOR", vbTextCompare) > 0 Then
' If the criteria is met, send an email alert
SendEmailAlert
' Exit the loop since we found a match
Exit For
End If
Next cell

' Call the CheckCriteria subroutine again in one minute
Application.OnTime Now + TimeValue("00:01:00"), "CheckCriteria"
End Sub

Sub SendEmailAlert()
Dim OutlookApp As Object
Dim OutlookMail As Object

' Create a new Outlook application and email
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
.To = "joey.cayago@gfigroup.com.ph"
.Subject = "Alert: MAJOR Detected in APAC MONITORING"
.Body = "The value 'MAJOR' has been detected in the APAC Spreadsheet Monitoring."
.Send
End With

Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

 

[joeyc123]

im getting this error message: