Macro filter email addresses in multiple columns

71 Views Asked by At

I want a macro to filter a sheet for all instances of our corporate email address regardless of which column they are in (50+ columns). I have tried Autofilter and AdvancedFilter without success. AdvancedFilter seems most likely, but I cannot find examples of the syntax for CriteriaRange.

I have read <>text can be used for wildcards, but have no idea how to use it.

The worksheet has the column headers in rows 10-11 (not my sheet, so I cannot change it).

My most recent attempt gives an Expected expression error:

Sub AdvancedFilter()

    If Sheets(2).FilterMode = True Then
        Sheets(2).ShowAllData
    End If

    Sheets(2).Range("A13:CO100").AdvancedFilter _
     Action:=xlFilterInPlace, _
     CriteriaRange:=(*mydomain.com)

End Sub
3

There are 3 best solutions below

1
FaneDuru On BEST ANSWER

Please, try the next way. It should be very fast, hiding the rows not containing the searched domain:

Sub filterByDomain()
  Dim sh As Worksheet, lastR As Long, lastCol As Long, rng As Range
  Dim rngHidd As Range, findC As Range, iRow As Range
  Const dom As String = "mydomain.com"
  
  Set sh = ActiveSheet 'use here the necessary sheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).Row 'last row
  lastCol = sh.cells(13, sh.Columns.count).End(xlToLeft).column 'last column on the headers row
 
  Set rng = sh.Range("A13", sh.cells(lastR, lastCol)) 'the range to be processed
  rng.EntireRow.Hidden = False 'unhide the previously hidden rows
  
  For Each iRow In rng.Resize(rng.rows.count - 1).Offset(1).rows 'iterate between rng rows, except the header:
    Set findC = iRow.Find(dom, iRow.cells(1), xlValues, xlPart)
    If findC Is Nothing Then 'if not finding the searched domain, place first row cell in a `Union` range
        addToRange rngHidd, iRow.cells(1)
    End If
  Next
  
  'hide the rows not containing the searched domain, at once:
  If Not rngHidd Is Nothing Then rngHidd.EntireRow.Hidden = True
  MsgBox "Ready..."
End Sub

Sub addToRange(rngU As Range, rng As Range) 'helping sub to build the Union range
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub
0
Tounn On

If i understand every e-mail your looking for contains "mydomain.com" at then end. Then this condition will catch everytime you meet this pattern :

Sub Filter()

   For each Cell in Range("A13:CO100")
       If Trim(Cell.Value) Like ("*mydomain.com") Then
           //do something
       Else
           //do something
       End If
   Next Cell

End Sub

The Like function check if the inner string pattern ("mydomain.com") with anything before * is in the Cell. The Trim function is just here to remove extra spaces before and after the text that the current cell contains. Just made a loop for the sake of example but you'll need to run through your data.

5
Bart On

Replace @ with your domain and try

Sub AdvancedFilter()

Dim r As range
Dim r1 As range
Dim s As string

If Sheets(2).FilterMode = True Then Sheets(2).ShowAllData 
EndIf

For each r in sheets(2).range("A13:A100")

For each r1 in sheets(2).range("A" & r.row & ":CO" & r.row)

S = r.value

If instr(s, "@") <> 0 then
R.entirerow.hide
Next r
End if
Next r1
Next r
 End Sub