Macro / module searching for "message prefix"

ExpExchHelp
ExpExchHelp used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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?
ExpExchHelpAnalyst

Author

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
Top Expert 2016
Commented:
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
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
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

ExpExchHelpAnalyst

Author

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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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
ExpExchHelpAnalyst

Author

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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial