Macro / module searching for "message content" (follow-up question)

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.

This post is an extension to a previous question (http://www.experts-exchange.com/questions/28911018/Macro-module-searching-for-message-content.html) where expert Rgonzo1971 has provided me a perfect solution.

The XLS file includes all details for the code modification.

Thank you in advance!!
EEH
Macro-Filter--New-Process--v03.xlsm
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.

Rgonzo1971Commented:
Hi,

pls try

Sub FindMessageTags()
Dim lngLastRowMP As Long
Dim lngLastRowData As Long
Dim lngRowMP As Long
Dim lngRowData As Long
Dim lngColDL As Long
Dim lngNR As Long
Dim wsDL As Worksheet
Dim wsSO As Worksheet
Dim wsData As Worksheet

Set wsData = Sheets("ExampleInput")
Set wsDL = Sheets("DynamicList")

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

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


With wsData
    For lngRowData = 1 To lngLastRowData
        lngColDL = -1 + simpleRegex(.Cells(lngRowData, "A"), "\d(?=\.0 message:)")
        lngLastRowDL = wsDL.Cells(1048576, lngColDL).End(xlUp).Row
        For lngRowDL = 1 To lngLastRowDL
            regexRes = simpleRegex(.Cells(lngRowData, "A"), wsDL.Cells(lngRowDL, lngColDL) & "[\s\S]*?>")
            If regexRes <> "" Then
                strResult = strResult & regexRes
            End If
        Next
        lngNR = lngNR + 1
        wsSO.Cells(lngNR, "A") = strResult
        strResult = ""
    Next
End With

End Sub
Private Function simpleRegex(myStr As String, strPattern As String) As String
    Dim regEx As New RegExp
    Dim strInput As String
    Dim Myrange As Range


    If strPattern <> "" Then
        strInput = myStr
        
        With regEx
            .Global = True
            .MultiLine = False
            .IgnoreCase = True
            .Pattern = strPattern


            Set allMatches = regEx.Execute(strInput)
        End With
        If allMatches.Count <> 0 Then
            simpleRegex = allMatches.Item(0)
        Else
           simpleRegex = ""
        End If
    End If
End Function

Open in new window

Regards
ExpExchHelpAnalystAuthor Commented:
Rgonzo1971:

Thank you... I tried it but it doesn't work (just yet).

Please see my comments (textboxes) on the SampleOutput tab.

Again, thank you for your help.
EEH
Macro-Filter--New-Process--v04.xlsm
Rgonzo1971Commented:
then try

Sub FindMessageTags()

    'Solution was provided by expert 'Rgonzo1971'

    'Declare variables
    Dim lngLastRowMP As Long
    Dim lngLastRowData As Long
    Dim lngRowMP As Long
    Dim lngRowData As Long
    Dim lngColDL As Long
    Dim lngNR As Long
    Dim wsDL As Worksheet
    Dim wsSO As Worksheet
    Dim wsData As Worksheet
    
    Set wsData = Sheets("ExampleInput")
    Set wsDL = Sheets("Filters")
    
    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
    
    lngLastRowData = wsData.Range("A1048576").End(xlUp).Row
    
    
    With wsData
        For lngRowData = 1 To lngLastRowData
            lngColDL = 2 + (simpleRegex(.Cells(lngRowData, "A"), "\d(?=\.0 message:)") - 2) * 3
            lngLastRowDL = wsDL.Cells(1048576, lngColDL).End(xlUp).Row
            For lngRowDL = 1 To lngLastRowDL
                regexRes = simpleRegex(.Cells(lngRowData, "A"), wsDL.Cells(lngRowDL, lngColDL) & "[\s\S]*?>")
                If regexRes <> "" Then
                    strResult = strResult & regexRes
                End If
            Next
            lngNR = lngNR + 1
            wsSO.Cells(lngNR, "A") = strResult
            strResult = ""
        Next
    End With

End Sub
Private Function simpleRegex(myStr As String, strPattern As String) As String
    Dim regEx As New RegExp
    Dim strInput As String
    Dim Myrange As Range


    If strPattern <> "" Then
        strInput = myStr
        
        With regEx
            .Global = True
            .MultiLine = False
            .IgnoreCase = True
            .Pattern = strPattern


            Set allMatches = regEx.Execute(strInput)
        End With
        If allMatches.Count <> 0 Then
            simpleRegex = allMatches.Item(0)
        Else
           simpleRegex = ""
        End If
    End If
End Function

Open in new window

Exploring SharePoint 2016

Explore SharePoint 2016, the web-based, collaborative platform that integrates with Microsoft Office to provide intranets, secure document management, and collaboration so you can develop your online and offline capabilities.

ExpExchHelpAnalystAuthor Commented:
Rgonzo1971:

Wow... very impressive.    This works great.

There's just one small change that I'd like to be considered.   That is, I need one additional column (not part of the "3 filters" concept though) to be transferred from the Input to Output tab.

Please see additional information on the attached XLS.

Thank you in advance for your help.

EEH
Macro-Filter--New-Process--v06.xlsm
Rgonzo1971Commented:
then try

Sub FindMessageTags()

    'Solution was provided by expert 'Rgonzo1971'

    'Declare variables
    Dim lngLastRowMP As Long
    Dim lngLastRowData As Long
    Dim lngRowMP As Long
    Dim lngRowData As Long
    Dim lngColDL As Long
    Dim lngNR As Long
    Dim wsDL As Worksheet
    Dim wsSO As Worksheet
    Dim wsData As Worksheet
    
    Set wsData = Sheets("ExampleInput")
    Set wsDL = Sheets("Filters")
    
    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
    
    lngLastRowData = wsData.Range("B1048576").End(xlUp).Row
    
    
    With wsData
        For lngRowData = 1 To lngLastRowData
            lngColDL = 2 + (simpleRegex(.Cells(lngRowData, "B"), "\d(?=\.0 message:)") - 2) * 3
            lngLastRowDL = wsDL.Cells(1048576, lngColDL).End(xlUp).Row
            For lngRowDL = 1 To lngLastRowDL
                regexRes = simpleRegex(.Cells(lngRowData, "B"), wsDL.Cells(lngRowDL, lngColDL) & "[\s\S]*?>")
                If regexRes <> "" Then
                    strResult = strResult & regexRes
                End If
            Next
            lngNR = lngNR + 1
            wsSO.Cells(lngNR, "B") = strResult
            wsSO.Cells(lngNR, "A") = .Cells(lngRowData, "A")
            strResult = ""
        Next
    End With

End Sub
Private Function simpleRegex(myStr As String, strPattern As String) As String
    Dim regEx As New RegExp
    Dim strInput As String
    Dim Myrange As Range


    If strPattern <> "" Then
        strInput = myStr
        
        With regEx
            .Global = True
            .MultiLine = False
            .IgnoreCase = True
            .Pattern = strPattern


            Set allMatches = regEx.Execute(strInput)
        End With
        If allMatches.Count <> 0 Then
            simpleRegex = allMatches.Item(0)
        Else
           simpleRegex = ""
        End If
    End If
End Function

Open in new window

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
ExpExchHelpAnalystAuthor Commented:
Rgonzo1971:

As always, your solution (and fantastic help) is most brilliant!   Thank you so much for assisting w/ this solution.

In the event the solution (i.e., underlying problem) requires additional help, I will post a new question.

Again, thank you!!
EEH
ExpExchHelpAnalystAuthor Commented:
Rgonzo1971:

Again, thank you for your help.

I'm trying to learn more about this particular method.   Which line(s) of code were changed/added to include column A into this process?   In the event I would need to add additional columns (either before or after) current column B.

Thank you,
EEH
ExpExchHelpAnalystAuthor Commented:
Rgonzo1971:

Well, I need to follow up with yet another question.

All worked well running the data with the "dummy" data.   However, once I ran it w/ actual data, the solution doesn't work as envisioned.    The issue lies solely w/ me, given that I oversimplified the "dummy" data.

More specifically, I indicated that the three different message types begin with:
"Received ABCD 2.0 message:"
"Received ABCD 3.0 message:"
"Received ABCD 4.0 message:"

Well the differentiation of "2.0", "3.0", and "4.0" may have made it easier to follow the theoretical concept of the problem, it now hampered the actual solution given that the actual message prefix look rather different.   That is, below are three example of message types that I am after:
"Received ABCD 2.0 message:"
"GPS Position ID:"
"Sending message bytes:"

So, ultimately, the VBA lines (see below) throw error given that the prefix construct is completely different:
            lngColDL = 2 + (simpleRegex(.Cells(lngRowData, "B"), "\d(?=\.0 message:)") - 2) * 3
            lngLastRowDL = wsDL.Cells(1048576, lngColDL).End(xlUp).Row


All that said, is there a way to specific (again, maybe via a "CASE" statement) what the beginning construct of each message type is.   When a match has been found (e.g., message type begins with "GPS Position ID:"), case 2 and filter criteria 2 are executed?

I hope this makes sense.   If needed, I'll open a new question.   Please let me know.

Thank you,
EEH
ExpExchHelpAnalystAuthor Commented:
Rgonzo1971:

Please see above posting first... 'quick follow-up though.

While potentially NOT the most *efficient* method w/ respect to coding, the most straight-forward method for capturing all different scenarios would be the implementation of some form of matrix (on the filters tab).

That is,
- if message type in cell A1 = "Received ABCD 2.0 message:", then use fields list in cells A2, A3, A4, etc.
- if message type in cell B1 = "GPS Position ID:":", then use fields list in cells B2, B3, etc.
- if message type in cell C1 = "GPS Position ID:":", then use fields list in cells C2, C2, C4, C5, etc.
- same for other message types.

Essentially, I would populate this matrix and simply add message type "prefix" followed by completing the matrix.   This would require the VBA parser to "understand" that some message types have more (or less) fields than others.

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.