Searching Worksheet for Certain Data

Hello Experts,

I have a brilliant macro provided by byundt to search through the message column (E) in one worksheet and extract data based on the headings in another worksheet.  The data is then copied into the worksheet under the correct headings.

I have run into a problem with using this macro on another worksheet.  It works perfectly if the format of the data in column E remains static.  Unfortunately, the data I have can give at least two different messages:

Cell 1 can give -   Account Name:      Supplied Realm Name:      User ID:      Service Name:      Service ID:      Client Address:      Client Port:      Ticket Options:      Result Code:      Ticket Encryption Type:

Cell 2 can give - Authentication Package:      Logon Account:      Source Workstation:      Error Code:

I would like to amend the macro to taking into account the different format of messages which can be found in column E.

I would be grateful for any help.
Regards,
InfoSec36
Mixed-Data.xls
Sonia BowditchInformation Security OfficerAsked:
Who is Participating?
 
byundtConnect With a Mentor Commented:
I shortened the code to look for the header labels and enter a value if one exists. If not, then continue to the next label.
Sub ParseAD_Report()
Dim cel As Range, rg As Range, targ As Range
Dim v As Variant, vHeaders As Variant
Dim s As String
Dim i As Long, j As Long, k As Long, n As Long, nHeaders As Long
Application.ScreenUpdating = False
With Worksheets("Formatted")
    Set rg = .Range("E2")       'First cell with data
    Set rg = .Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp))
End With
With Worksheets("Formatted2")
    Set targ = .Range("A1")     'First header label
    Set targ = .Range(targ, .Cells(1, .Columns.Count).End(xlToLeft))    'All the header labels
    vHeaders = targ.Value
    nHeaders = targ.Columns.Count
    n = .UsedRange.Rows.Count
End With
For Each cel In rg.Cells
    s = cel.Value
    If s <> "" Then
        n = n + 1
        j = 1
        For k = 1 To nHeaders
            If vHeaders(1, k) <> "" Then
                v = Application.Search(vHeaders(1, k), s, 1)
                If Not IsError(v) Then
                    i = v + Len(vHeaders(1, k))
                    j = Application.Search(vbLf, s & vbLf, i)
                    targ.Cells(n, k).Value = Trim(Mid$(s, i, j - i))
                End If
            End If
        Next
    End If
Next
End Sub

Open in new window

Mixed-DataQ28367754.xls
0
 
c_kedarConnect With a Mentor Commented:
Sub ParseColE()
    Dim ws2 As Worksheet
    Set ws2 = Worksheets("Formatted2")
    Dim rg As Range
    With Worksheets("Formatted")
        Set rg = .Range("E2")
        Set rg = .Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp))
    End With
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "(.*:)(.*)\n"
    re.Global = True
    Dim var As Variant
    For Each cel In rg.Cells
        Set mm = re.Execute(cel.Text)
        For Each m In mm
            k = m.SubMatches(0)
            v = m.SubMatches(1)
            var = Application.Match(k, ws2.Rows(1), 0)
            If Not IsError(var) Then
                ws2.Cells(cel.Row, var) = v
            End If
        Next
    Next
End Sub

Open in new window

0
 
byundtCommented:
When testing c_kedar's code, change statement 14 to:
        Set mm = re.Execute(cel.Text & vbLf)

Open in new window


Without that tweak, it wasn't picking up the last field in each cell.
0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
Anne TroyEast Coast ManagerCommented:
Yeah. He is a bit brilliant, isn't he? Hey Brad! :)
0
 
byundtCommented:
Long time no see, Anne.
0
 
Sonia BowditchInformation Security OfficerAuthor Commented:
Thanks  byundt.  The modification to the macro you had already designed worked brilliantly as usual :)  

c_kedar - thanks very much for your code.  It also works brilliantly.

Regards,
InforSec36
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.