Allow only email address format in Excel cell

‘ --- beginning of code ---
Function IsValidEmail(mytext As String) As Boolean
Dim RE As Object
Dim REPattern As String
Dim REMatches As Object
 
Set RE = CreateObject("vbscript.regexp")
REPattern = "^[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+(?:[A-Z]{2}|com|org|net|edu|gov|mil|biz|info|mobi|name|aero|asia|jobs|museum)$"
RE.Global = True
RE.ignorecase = True
RE.Pattern = REPattern
 
Set REMatches = RE.Execute(mytext)
 
IsValidEmail = (REMatches.Count > 0)
 
End Function
‘ --- end of code ---

‘ --- beginning of code ---
Private Sub Worksheet_Change(ByVal Target As Range)
Dim response
If Not Intersect([A1], Target) Is Nothing Then
'A1 has been changed
If Not WorksheetFunction.CountA(Target) = 0 Then
'The cell is not blank
If Not IsValidEmail(Target.Text) Then
'the contents are not an email address
MsgBox Title:="Invalid entry", Prompt:="Only valid email addresses allowed.", Buttons:=vbCritical + vbOKOnly
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End If
End If
End Sub
‘ --- end of code ---