Delete certain email addresses from a column?

sobeitjedi

Board Regular
Joined
Mar 13, 2006
Messages
235
Office Version
  1. 365
Hi.

In column A i have thousands of rows of email addresses (1 address per row). What I want to do is run a macro which deletes all rows that aren't @Hotmail.com @outlook.com @live.com , so my list after running the macro only contains addresses with these domains. How do I achieve this?
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Based on the title of your thread, this will condense the list of email addresses in col A to only those containing one of your 3 choices, but it does not delete any rows. Do you have data associated with each email address in columns adjacent to col A that needs to be deleted or cleared?
Code:
Sub DeleteAllBut()
Dim Vin As Variant, Vout As Variant, i As Long, ct As Long
Vin = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
ReDim Vout(1 To UBound(Vin, 1), 1 To 1)
For i = LBound(Vin, 1) To UBound(Vin, 1)
    If InStr(Vin(i, 1), "@") > 0 Then
        If Vin(i, 1) Like "*@Hotmail.com" Or Vin(i, 1) Like "*@Outlook.com" Or Vin(i, 1) Like "*@live.com" Then
            ct = ct + 1
            Vout(ct, 1) = Vin(i, 1)
        End If
    End If
Next i
If ct > 0 Then
    Application.ScreenUpdating = False
    Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
    Range("A1:A" & ct).Value = Vout
    Application.ScreenUpdating = True
End If
End Sub
 
Upvote 0
Yes, there is data across the rows which needs deleting.
In that case, try this:
Code:
Sub DeleteAllBut()
Dim Vin As Variant, i As Long, ct As Long
Vin = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
ReDim Vout(1 To UBound(Vin, 1), 1 To 1)
For i = LBound(Vin, 1) To UBound(Vin, 1)
    If InStr(Vin(i, 1), "@") > 0 Then
        If Not (Vin(i, 1) Like "*@Hotmail.com" Or Vin(i, 1) Like "*@Outlook.com" Or Vin(i, 1) Like "*@live.com") Then
            ct = ct + 1
            Vin(i, 1) = "#N/A"
        End If
    End If
Next i
If ct > 0 Then
    Application.ScreenUpdating = False
    On Error Resume Next
    With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        .Value = Vin
        .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    End With
    On Error GoTo 0
    Application.ScreenUpdating = True
End If
End Sub
 
Last edited:
Upvote 0
In that case, try this:
Code:
Sub DeleteAllBut()
Dim Vin As Variant, i As Long, ct As Long
Vin = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
ReDim Vout(1 To UBound(Vin, 1), 1 To 1)
For i = LBound(Vin, 1) To UBound(Vin, 1)
    If InStr(Vin(i, 1), "@") > 0 Then
        If Not (Vin(i, 1) Like "*@Hotmail.com" Or Vin(i, 1) Like "*@Outlook.com" Or Vin(i, 1) Like "*@live.com") Then
            ct = ct + 1
            Vin(i, 1) = "#N/A"
        End If
    End If
Next i
If ct > 0 Then
    Application.ScreenUpdating = False
    On Error Resume Next
    With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        .Value = Vin
        .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    End With
    On Error GoTo 0
    Application.ScreenUpdating = True
End If
End Sub

No, didn't work - not sure what's happened but it only returned a small amount of "hotmail.com" rows, all other rows were deleted, when I know there are addresses of the other type and a lot more hotmail.com addresses????
 
Upvote 0
Hi.

In column A i have thousands of rows of email addresses (1 address per row). What I want to do is run a macro which deletes all rows that aren't @Hotmail.com @outlook.com @live.com , so my list after running the macro only contains addresses with these domains. How do I achieve this?
Give this a try in a copy of your workbook.

Rich (BB code):
Sub Del_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  
  Const sEmailCol As String = "A" 'Column with email addresses
  
  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range(sEmailCol & 2, Range(sEmailCol & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    Select Case Split(a(i, 1), "@")(1)
      Case "hotmail.com", "outlook.com", "live.com"
      Case Else
        b(i, 1) = 1
        k = k + 1
    End Select
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 
Upvote 0
Give this a try in a copy of your workbook.

Rich (BB code):
Sub Del_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  
  Const sEmailCol As String = "A" 'Column with email addresses
  
  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range(sEmailCol & 2, Range(sEmailCol & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    Select Case Split(a(i, 1), "@")(1)
      Case "hotmail.com", "outlook.com", "live.com"
      Case Else
        b(i, 1) = 1
        k = k + 1
    End Select
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

Nope - sorry! Got even less results than before. Does it make a difference that I'm adding a fourth email address into the line where the case is defined? Don't think so.
 
Upvote 0
Nope - sorry! Got even less results than before. Does it make a difference that I'm adding a fourth email address into the line where the case is defined? Don't think so.
No, that shouldn't matter.
Perhaps you need to give us a small set of sample data and the expected results.

Here is my sample data ...


Excel 2016
ABCD
1emailData 1Data 2Data 3
2abc@hotmail.comxx
3fsfjkj@hhhhht.com.auxx
4njdh_kjjl@outlook.comxx
5khkfghk@outlook.com.ukxx
6xvxvzx@abc.netxx
7jhgjkdhj@live.comxx
8
Sheet4



.. and the result after running my posted code


Excel 2016
ABCD
1emailData 1Data 2Data 3
2abc@hotmail.comxx
3njdh_kjjl@outlook.comxx
4jhgjkdhj@live.comxx
5
Sheet4


In what way(s) does this ..
- not represent your data
- not give the expected results?
 
Upvote 0
No, that shouldn't matter.
Perhaps you need to give us a small set of sample data and the expected results.

Here is my sample data ...


Excel 2016
ABCD
1emailData 1Data 2Data 3
2abc@hotmail.comxx
3fsfjkj@hhhhht.com.auxx
4njdh_kjjl@outlook.comxx
5khkfghk@outlook.com.ukxx
6xvxvzx@abc.netxx
7jhgjkdhj@live.comxx
8
Sheet4



.. and the result after running my posted code


Excel 2016
ABCD
1emailData 1Data 2Data 3
2abc@hotmail.comxx
3njdh_kjjl@outlook.comxx
4jhgjkdhj@live.comxx
5
Sheet4


In what way(s) does this ..
- not represent your data
- not give the expected results?

At the moment, when I try to run it I get script out of range? The debugger highlights:

Select Case Split(a(i, 1), "@")(1)
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,306
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top