How do I isolate all company addresses ?

[Maverick27]

Attn all Excel Gurus

I have an Excel sheet of 500K Email Addresses.

How do isolate all company addressess eg addresses which DON'T have the following domains ?

@Yahoo ;
@gmail ;
@Hotmail ;
@Live ;
@ymail ;
@msn

Anyone care to share a Excel function or Macro to filter out the company address domains.

Below is a screenshot of the Excel list.

Thanks in Advance.

 

[Fluff]

Do you just want the domains such as unchr & yu?

 

[Maverick27]

Do you just want the domains such as unchr & yu?

I want all other domains which don't have:

@Yahoo ;
@gmail ;
@Hotmail ;
@Live ;
@ymail ;
@msn

There are numerous other domains besides unchr & yu

in short the logic =! @Yahoo or @gmail or @Hotmail or @Live or @ymail or @msn

 

[BSALV]

what is your excel version ?

 

[Maverick27]

what is your excel version ?

MS Professional Plus 2013

 

[DeficientOptimism]

 IF(ISNUMBER(SEARCH("@Yahoo",A2)),"Needs to be excluded",IF(ISNUMBER(SEARCH("@Gmail",A2)),"Needs to be excluded",IF(ISNUMBER(SEARCH("@Hotmail",A2)),"Needs to be excluded",IF(ISNUMBER(SEARCH("@Live",A2)),"Needs to be excluded",IF(ISNUMBER(SEARCH("@ymail",A2)),"Needs to be excluded",IF(ISNUMBER(SEARCH("@msn",A2)),"Needs to be excluded","Include"))))))

I think this should work but may potentially be very slow calculating your sheet given the size of the workbook.

There is probably a better approach to this.

 

[Fluff]

MS Professional Plus 2013

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[mohadin]

How about

Sub test()
    Dim a, b
    Dim i, k
    k = 1
    a = Sheets("sheet1").Cells(2, 1).Resize(Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row - 1)
    ReDim b(1 To UBound(a))
    With CreateObject("VBScript.RegExp")
        .Pattern = "@yahoo|@gmail|@hotmail|@live|@ymail|@msn"
        .IgnoreCase = True
        For i = 1 To UBound(a)
            If .test(a(i, 1)) Then
                b(k) = a(i, 1)
                k = k + 1
            End If
        Next
    End With
    Sheets("sheet1").Cells(2, 2).Resize(k - 1) = Application.Transpose(b)
End Sub

 

[Fluff]

How about

Sub Maverick()
   Dim Ary As Variant, Nary As Variant, Sp As Variant
   Dim Lst As String
   Dim r As Long, nr As Long
   
   Lst = "|Yahoo|gmail|Hotmail|Live|ymail|msn"
   Ary = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value2
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         Sp = Split(Split(Ary(r, 1), "@")(1), ".")(0)
         If InStr(1, Lst, "|" & Sp & "|", vbTextCompare) = 0 Then
            If Not .Exists(Sp) Then
               nr = nr + 1
               Nary(nr, 1) = Sp
               .Add Sp, Nothing
            End If
         End If
      Next r
   End With
   Range("B2").Resize(nr).Value = nr
End Sub

 

[JEC]

Or

Sub jec()
 With Range("A1", Range("A" & Rows.Count).End(xlUp))
   .AutoFilter 1, Filter(Filter(Filter(Filter(Filter(Filter(Application.Transpose(.Value), "@Yahoo", 0, 1), "@Gmail", 0, 1), "@Hotmail", 0, 1), "@Live", 0, 1), "@ymail", 0, 1), "@msn", 0, 1), 7
 End With
End Sub