PDA

View Full Version : How do I copy and paste cells that contain "@ml.com"



Shaolin
04-15-2009, 09:18 AM
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)?

Oorang
04-15-2009, 09:54 AM
This should run pretty quick. Select the column you want and go:
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