Delete certain email addresses from a column?

[sobeitjedi]

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?

 

[JoeMo]

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?

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

 

[sobeitjedi]

Yes, there is data across the rows which needs deleting.

 

[JoeMo]

Yes, there is data across the rows which needs deleting.

In that case, try this:

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

 

[sobeitjedi]

In that case, try this:

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????

 

[Peter_SSs]

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.

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

 

[sobeitjedi]

Give this a try in a copy of your workbook.

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.

 

[Peter_SSs]

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
	A	B	C	D
1	email	Data 1	Data 2	Data 3
2	abc@hotmail.com		x	x
3	fsfjkj@hhhhht.com.au		x	x
4	njdh_kjjl@outlook.com		x	x
5	khkfghk@outlook.com.uk		x	x
6	xvxvzx@abc.net		x	x
7	jhgjkdhj@live.com		x	x
8
Sheet4

.. and the result after running my posted code

Excel 2016
	A	B	C	D
1	email	Data 1	Data 2	Data 3
2	abc@hotmail.com		x	x
3	njdh_kjjl@outlook.com		x	x
4	jhgjkdhj@live.com		x	x
5
Sheet4

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

 

[sobeitjedi]

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
	A	B	C	D
1	email	Data 1	Data 2	Data 3
2	abc@hotmail.com		x	x
3	fsfjkj@hhhhht.com.au		x	x
4	njdh_kjjl@outlook.com		x	x
5	khkfghk@outlook.com.uk		x	x
6	xvxvzx@abc.net		x	x
7	jhgjkdhj@live.com		x	x
8
Sheet4

.. and the result after running my posted code

Excel 2016
	A	B	C	D
1	email	Data 1	Data 2	Data 3
2	abc@hotmail.com		x	x
3	njdh_kjjl@outlook.com		x	x
4	jhgjkdhj@live.com		x	x
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)

 

[Peter_SSs]

so..

Perhaps you need to give us a small set of sample data and the expected results.