Solved

Searching Worksheet for Certain Data

Posted on 2014-02-18
6
264 Views
Last Modified: 2014-02-19
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
0
Comment
Question by:Sonia Bowditch
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
6 Comments
 
LVL 2

Assisted Solution

by:c_kedar
c_kedar earned 200 total points
ID: 39868508
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
 
LVL 81

Accepted Solution

by:
byundt earned 300 total points
ID: 39868624
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
 
LVL 81

Expert Comment

by:byundt
ID: 39868649
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 22

Expert Comment

by:Dreamboat
ID: 39869253
Yeah. He is a bit brilliant, isn't he? Hey Brad! :)
0
 
LVL 81

Expert Comment

by:byundt
ID: 39869283
Long time no see, Anne.
0
 

Author Closing Comment

by:Sonia Bowditch
ID: 39869704
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

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question