Macro / module searching for "message prefix"

Hello Experts:

I kindly request your assistance in developing a macro (in VBA) that allows me to search through a spreadsheet that contains several tens of thousands of records.

As a picture is worth a thousands words, I have attached an example XLS with additional information.

I tried to keep the information and background generic and short.   Hopefully, the info in the XLS provides sufficient detail.   If not, please don't hesitate to ask for additional info.

Thank you in advance!!
EEH
Macro--Searching-for-Message-Prefix.xlsx
ExpExchHelpAnalystAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
In the file you say
"...the "scan" (in column B) should extract content of both column A and column B into another worksheet (or external XLS file)."

Do you sometimes want one or the other or can it be only a worksheet in the current workbook?
ExpExchHelpAnalystAuthor Commented:
Martin:

Thank you for the lightning-fast response... I appreciate it.

Ultimately, whatever is easier for extraction purposes.   If either method is equally straight-forward, then I would prefer to add the content to another tab (within same spreadsheet).

EEH
Rgonzo1971Commented:
Hi,

pls try ( I added title in Sheets Example data & SampleOutput fo facilitate the macro)

Sub Macro1()
'
'
Worksheets("SampleOutput").Range("A2:A100000").EntireRow.Delete
Sheets("ExampleData").Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Sheets("MessagePrefix").Range(Sheets("MessagePrefix").Range("A1"), Sheets("MessagePrefix").Range("A" & Rows.Count).End(xlUp))
    Set myRange = Nothing
    Range("A:B").AutoFilter Field:=2, Criteria1:= _
        "=" & c & "*", Operator:=xlAnd
    On Error Resume Next
    Set myRange = Range("A2:B" & LastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not IsEmpty(myRange) Then
        myRange.Copy Sheets("SampleOutput").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
Next
Range("A:B").AutoFilter
With Worksheets("SampleOutput").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("A1" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

Open in new window

Macro--Searching-for-Message-Prefix.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Your Guide to Achieving IT Business Success

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

Download eBook now!
Martin LissOlder than dirtCommented:
Don't give me any points if Rgonzo1971's code works for you.
Sub FindMessagePrefixes()
Dim lngLastRowMP As Long
Dim lngLastRowData As Long
Dim lngRowMP As Long
Dim lngRowData As Long
Dim lngNR As Long
Dim wsMP As Worksheet
Dim wsSO As Worksheet
Dim wsData As Worksheet

Set wsData = Sheets("ExampleData")
Set wsMP = Sheets("MessagePrefix")

On Error Resume Next
Set wsSO = Sheets("SampleOutput")
If Err.Number = 9 Then
    ' The sheet doesn't exist so create it
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = "SampleOutput"

Else
    wsSO.Cells.Clear
End If
On Error GoTo 0

lngLastRowMP = wsMP.Range("A1048576").End(xlUp).Row
lngLastRowData = wsData.Range("A1048576").End(xlUp).Row

For lngRowMP = 1 To lngLastRowMP
    With wsData
        For lngRowData = 1 To lngLastRowData
            If InStr(1, .Cells(lngRowData, "B"), wsMP.Cells(lngRowMP, "A")) > 0 Then
                lngNR = lngNR + 1
                wsSO.Cells(lngNR, "A") = .Cells(lngRowData, "A")
                wsSO.Cells(lngNR, "B") = .Cells(lngRowData, "B")
            End If
        Next
    End With
Next
End Sub

Open in new window

ExpExchHelpAnalystAuthor Commented:
Rgonzo1971, Martin Liss:

Both solutions work great... thus, I wanted to award points to both of you.   I hope that's ok.

Given that Rgonzo provided his solution first, I awarded the majority of points to him.

Again, both solutions exactly follow the envisioned process.   Thank you for coming up with such an excellent solution!!!  

As always, I appreciate your assistance.

Cheers,
EEH
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.

Marty - MVP 2009 to 2015, Experts-Exchange Top Expert Visual Basic Classic 2012 to 2014
ExpExchHelpAnalystAuthor Commented:
Rgonzo1971, Martin Liss:

Again, thank you for your most excellent help yesterday.   Based on the same process, I now have a need for another process.   I think this one, however, may be a bit more challenging (at least from my perspective).

Below is the URL (new question):
http://www.experts-exchange.com/questions/28911018/Macro-module-searching-for-message-content.html

It would be awesome if you please have a look at this requirements/need.  

Thank you in advance,
EEH
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.