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

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

Select allOpen in new window

Regards

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

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

Select allOpen in new window

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

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

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

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

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