There are 10,000 or so email addresses in a spreadsheet in column F, some of which contains "@ml.com" How can I copy just those email address (the entire row - Column A through Column Q in another worksheet)?
There are 10,000 or so email addresses in a spreadsheet in column F, some of which contains "@ml.com" How can I copy just those email address (the entire row - Column A through Column Q in another worksheet)?
This should run pretty quick. Select the column you want and go:
[VBA]Option Explicit
Public Sub Example()
Dim strCriteria As String
strCriteria = InputBox("Please enter the criteria:", "Enter Criteria", "@ml.com")
If LenB(strCriteria) = 0 Then Exit Sub 'detect cancel
SendSelectionToNewWB strCriteria
End Sub
Public Sub SendSelectionToNewWB(ByVal criteria As String)
Dim rng As Excel.Range
Dim rngCll As Excel.Range
Dim wsNew As Excel.Worksheet
Dim lngRow As Long
On Error GoTo Err_Hnd
ToggleInterface False
Set rng = Excel.Intersect(Excel.Selection, Excel.ActiveSheet.UsedRange)
Set wsNew = Excel.Workbooks.Add.Worksheets(1&)
For Each rngCll In rng.Cells
If InStrB(LCase$(rngCll.Value), criteria) Then
lngRow = lngRow + 1&
wsNew.Cells(lngRow, 1).Value = rngCll.Value
End If
Next
Exit_Proc:
On Error Resume Next
ToggleInterface True
Exit Sub
Err_Hnd:
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbApplicationModal + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
Resume Exit_Proc
End Sub
Private Sub ToggleInterface(ByVal interfaceOn As Boolean)
With Excel.Application
.EnableEvents = interfaceOn
.EnableCancelKey = IIf(interfaceOn, xlInterrupt, xlErrorHandler)
.Cursor = IIf(interfaceOn, xlDefault, xlWait)
.StatusBar = IIf(interfaceOn, False, "Working...")
.ScreenUpdating = interfaceOn
End With
End Sub
[/VBA]
Cordially,
Aaron
Keep Our Board Clean!
- Please Mark your thread "Solved" if you get an acceptable response (under thread tools).
- Enclose your code in VBA tags then it will be formatted as per the VBIDE to improve readability.