VBA to remove all email addresses from cells

[NeoSez]

I was using a find & replace @*, to remove all email addresses. It was working fine until a new person joined and starting adding @ in front of every person's name thinking it will be like in Outlook (grrrrr). So when I do the find & replace, it removes everything in the cell instead of only removing the email addresses.
I am open to suggestions on how to remove all the email addresses only from one column. The other content before or after an email address must not be deleted however, unless it is another email address. I can not delete by domain because there is just thousands of variations.

Here is an example of what it a typical entry looks like in each cell under column "F":

June 27, 2024
Meeting with Jack Black - jack.black@sample.com
June 26, 2024
Unable to verify funds from deadbeat@home.pa
June 25, 2024
Package sent to momma@home.us

Wondering if I can revise this script to suit my needs somehow. It checks the string for @. If the @ is present, it looks for the preceding comma and clips the string at the point

Public Function noemail(s As String) As String
    Dim i As Long, L As Long

    If InStr(s, "@") = 0 Then
        noemail = s
        Exit Function
    End If
  
    L = Len(s)
    For i = L To 1 Step -1
        If Mid(s, i, 1) = "," Then
            noemail = Left(s, i - 1)
            Exit Function
        End If
    Next i
  
End Function

 

[AlphaFrog]

Public Function noemail(s As String) As String
   
    Dim email As Object
   
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([a-zA-ZF0-9\u00C0-\u017F._-]+@[a-zA-Z0-9\u00C0-\u017F._-]+\.[a-zA-Z0-9\u00C0-\u017F_-]+)|([a-zA-Z0-9\u00C0-\u017F._-]+\.[a-zA-Z0-9\u00C0-\u017F_-]+)"
        For Each email In .Execute(s)
            s = Replace(s, email, "")
        Next
    End With
   
    noemail = Application.Trim(s)
 
End Function