Remove Specific email addresses from a long list of emails

[fapb48]

Hi,

This might be a difficult one.

I have tasked to do message trace reports for the company i work for.

I need to do a trace on the outbound and inbound emails from specific users.

When the data is generated (thousands of emails) i then need to manipulate the csv to filter only what was sent/received from external emails.

And this is where it gets complicated..

Is there a way to filter everything that comes from external and delete so i can only see what was sent/received from external domains?

Examples below:

Inbound report:
i need to be able to filter everything that was sent from external to specific email addresses within the company.
The report generates everything that those emails have received (internal and external).
The problem here is that in some occasions those specific emails receive internal emails and sometimes they also receive internal email an external email address (this happens when the sender sends to multiple people)

Example
removed sensitive information

The first 3 rows are great. they come only from external.
In 4th row it needs to be deleted because its from an internal email to only internal emails
In the 5th and 6th row its an internal email address sending email to both internal and external, which is fine. that needs to stay.

So - how do i filter rows that only contains "tibbettsgroup" and delete them.. and if contains "tibbettsgroup" and other domains (external) nothing changes


Outbound Report

Very similar to above but in reverse
I need to be able to see what specific emails are sending to only external emails.
If from internal to internal needs to be deleted
If from internal to external needs to stay
If from internal to external and also contains internal address it also needs to stay


This is probably easier to visualise rather than explaining here. so here is the onedrive link: Removed link

 

[mumps]

Try the first macro on the Inbound sheet and the second on the Outbound sheet.

Sub RemoveInEmailAddresses()
    Application.ScreenUpdating = False
    Dim addr As String, v As Variant, i As Long, ii As Long, inWS As Worksheet, val As Variant
    addr = "acmegroup.com"
    Set inWS = Sheets("Inbound")
    v = inWS.Range("B2", inWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = UBound(v) To LBound(v) Step -1
        If InStr(1, v(i, 1), addr) > 0 Then
            val = Split(v(i, 2), "@")
            For ii = 1 To UBound(val)
                If InStr(1, val(ii), addr) = 0 Then
                    inWS.Rows(i + 1).Delete
                    Exit For
                End If
            Next ii
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Sub RemoveOutEmailAddresses()
    Application.ScreenUpdating = False
    Dim addr As String, v As Variant, i As Long, outWS As Worksheet
    addr = "acmegroup.com"
    Set outWS = Sheets("Outbound")
    v = outWS.Range("B2", outWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = UBound(v) To LBound(v) Step -1
        If InStr(1, v(i, 1), addr) > 0 Then
            If UBound(Split(v(i, 2), "acme")) = UBound(Split(v(i, 2), ".com")) Then
                outWS.Rows(i + 1).Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[fapb48]

Try the first macro on the Inbound sheet and the second on the Outbound sheet.

Sub RemoveInEmailAddresses()
    Application.ScreenUpdating = False
    Dim addr As String, v As Variant, i As Long, ii As Long, inWS As Worksheet, val As Variant
    addr = "acmegroup.com"
    Set inWS = Sheets("Inbound")
    v = inWS.Range("B2", inWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = UBound(v) To LBound(v) Step -1
        If InStr(1, v(i, 1), addr) > 0 Then
            val = Split(v(i, 2), "@")
            For ii = 1 To UBound(val)
                If InStr(1, val(ii), addr) = 0 Then
                    inWS.Rows(i + 1).Delete
                    Exit For
                End If
            Next ii
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Sub RemoveOutEmailAddresses()
    Application.ScreenUpdating = False
    Dim addr As String, v As Variant, i As Long, outWS As Worksheet
    addr = "acmegroup.com"
    Set outWS = Sheets("Outbound")
    v = outWS.Range("B2", outWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = UBound(v) To LBound(v) Step -1
        If InStr(1, v(i, 1), addr) > 0 Then
            If UBound(Split(v(i, 2), "acme")) = UBound(Split(v(i, 2), ".com")) Then
                outWS.Rows(i + 1).Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Thank you for your help on this but i think its actually working the other way around. its deleting all external emails.

On the inbound:
if the sender_address is an external address do nothing
if the sender_address is an internal address and the recepient is contains only internal email address delete the line
If the sender_address is an internal address and the recepient contains both internal and external email addresses do nothing


On the outbound:
If the recipient_address contains only internal addresses delete the line
If the recipient_address contains both internal and external addresses do nothing.

Thank you very much for your help on this
Fabio

 

[mumps]

Try:

Sub RemoveInEmailAddresses()
    Application.ScreenUpdating = False
    Dim addr As String, v As Variant, i As Long, ii As Long, inWS As Worksheet, val As Variant
    addr = "acmegroup.com"
    Set inWS = Sheets("Inbound")
    v = inWS.Range("B2", inWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = UBound(v) To LBound(v) Step -1
        If InStr(1, v(i, 1), addr) > 0 Then
            If UBound(Split(v(i, 2), "tibbetts")) = UBound(Split(v(i, 2), ".com")) Then
                inWS.Rows(i + 1).Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Sub RemoveOutEmailAddresses()
    Application.ScreenUpdating = False
    Dim addr As String, v As Variant, i As Long, outWS As Worksheet
    addr = "acmegroup.com"
    Set outWS = Sheets("Outbound")
    v = outWS.Range("B2", outWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = UBound(v) To LBound(v) Step -1
        If InStr(1, v(i, 1), addr) > 0 Then
            If UBound(Split(v(i, 2), "acme")) = UBound(Split(v(i, 2), ".com")) Then
                outWS.Rows(i + 1).Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub