Solved

Macro to seggregate data between two ALT + created row with in a cell

Posted on 2012-03-22
5
364 Views
Last Modified: 2012-03-28
Dear experts,

Need a macro which can identify an ALT+enter created row with in a cell and which can segregate the date between two ALT + strokes and pay the data in to a cell in new sheet.

If there are two ALT + entry strokes, then it should take data beggining after the two ALT+ strokes.

The required example is in sheet 'required

Thankyou,
0
Comment
Question by:Excellearner
  • 4
5 Comments
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
Did you mean to post a sample?

Dave
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
I think I got it.  You have data in Column A, for example, and some of the rows have Alt+Enter with data between another Alt+Enter.  You ALSO have some rows where the column A cell has two consecutive Alt+Enters.  E.g., data here Alt+EnterAlt+Enter and more data here.  In this second instance, you want the data after the two consecutive Alter+Enters, correct?

The app does that and puts the output on a newly cleaned Sheet2, which you can change the output sheet to suit, as commented in the code.

Here's the code:
Option Explicit

Sub parseData()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim i As Long, x As Long
Dim r As Range
Dim rng As Range
Dim strOut As String

    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet '<- change to suit
    Set wksOut = wkb.Sheets("Sheet2") '<- change to suit
    
    Set rng = wks.Range("A1", wks.Range("A" & wks.Rows.Count).End(xlUp))
    'clean output
    wksOut.Cells.ClearContents
    
    wksOut.Range("A1").Value = "Output"
    For Each r In rng
        If Evaluate("=LEN(" & r.Address & ")-LEN(SUBSTITUTE(" & r.Address & ",CHAR(10),""""))") Then 'found matching pair of Alt-Enter, so process
            strOut = getBetweenChars(r, Chr(10))
            If strOut <> vbNullString Then 'then there's data between the two ALT-Enter keystrokes, so output that
                wksOut.Range("A2").Offset(i, 0) = getBetweenChars(r, Chr(10))
            Else
                'there's no data between the two ALT-Enter keystrokes, so get the data after that
                x = Evaluate("=FIND(""^^^^"",SUBSTITUTE(" & r.Address & ",CHAR(10),""^^^^"",2))")
                wksOut.Range("A2").Offset(i, 0) = Right(r.Value, Len(r.Value) - x)
            End If
            i = i + 1
        End If
    Next r
    wksOut.Columns("A").AutoFit
End Sub

Open in new window


The code uses a function to find data between two strings, using regular expressions.  in this instance the function is called with a chr(10) (That's Alt-Enter) for both sides of the string to find, if there's data between the two:
Option Explicit
Const MetaChars = "^$.*+?|\()[]{}<>"
Function getBetweenChars(target As Range, myBracket As String) As String
'finds and returns first match between two strings that bracket the desired outcome
Dim wkb As Workbook
Dim wks As Worksheet
Dim searchCharLeft As String
Dim searchCharRight As String
Dim regEx As Object

Dim myStr As String
Dim myMatch As Object
Dim searchChar As String
Dim firstAddress As String
Dim fRange As Range
Dim rng As Range
    
    searchCharLeft = myBracket
    searchCharRight = myBracket
    
    If InStr(MetaChars, searchCharLeft) <> 0 Then
        searchCharLeft = "\" & searchCharLeft
    End If
    If InStr(MetaChars, searchCharRight) <> 0 Then
        searchCharRight = "\" & searchCharRight
    End If
    
    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
    Set rng = Selection
    
    Set regEx = CreateObject("VBScript.RegExp")
    
    With regEx
        .Global = True
        .MultiLine = False
        .Pattern = searchCharLeft & "(.*?)" & searchCharRight  'search for anything between < > brackets
    End With
    
    Set myMatch = regEx.Execute(target.Value)
    getBetweenChars = Replace(regEx.Execute(target.Value)(0), Chr(10), "")
    
    Set regEx = Nothing
End Function

Open in new window


See attached demo workbook, where I've created sample data to test both instances.

-----------------------------

Note the routine actually uses Excel formulas to find the data.  You could just as easily use these formulas and copy down to get the data.

I've put those formulas as an example, to the right of the test data, just in case this serves as the solution as well.

Here's the formula that gives the same output, in Column B, at B2 and copy down:
[B2]=IF(LEN($A2)-LEN(SUBSTITUTE($A2,CHAR(10),""))>0,IF(FIND("^^^^",SUBSTITUTE($A2,CHAR(10),"^^^^",2))-FIND("^^^^",SUBSTITUTE($A2,CHAR(10),"^^^^",1))=1,RIGHT($A2,LEN($A2)-FIND("^^^^",SUBSTITUTE($A2,CHAR(10),"^^^^",2))+2),MID($A2,FIND(CHAR(10),$A2),FIND("^^^^",SUBSTITUTE($A2,CHAR(10),"^^^^",2))-FIND(CHAR(10),$A2))),"")

Cheers,

Dave
parseAltEnterDate-r2.xls
0
 

Author Comment

by:Excellearner
Comment Utility
Dear dlmille,

thank you for the comment/sample

I have the following two comments:

1. In your original sample the code extracted only the second text string. The vba code should extract all the three text strings into two or three rows as the case may be.
2. When i put my sample, the
 the first macro the following error 'strOut = getBetweenChars(r, Chr(10))'
the second macro asked for the name of the macro and did not proceed.

Kindly can i request you to amend the macro accordingly.

Thankyou
parseAltEnterDate-r2-1-.xlsx
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
I'm not sure I understand.  The sample I submitted does exactly what your original question asked for - pull the data between two ALt-Enters, and pull the data after what I presumed to be two consecutive alt-Enters.

I will amend the macro, now that you have provided some meaningful examples.

Sheet1 makes sense.  Sheet2 does not.

Please explain before I proceed.

Cheers,

Dave
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
Comment Utility
See attached.  I changed the getBetweenChars() function to return the object of all submatches, after first ensuring every line has at least one (e.g., a line without alt-enters would still get output) and substituting each ALT-ENTER with an open/close set of brackets - "<<<<" and ">>>>" which are set as constants.

Your macro didn't run because you didn't copy all the code over.  There are TWO modules in the attached.

Here's the code in the first module:
Option Explicit
Const leftBracket = "<<<<"
Const rightBracket = ">>>>"
Sub parseData()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim i As Long
Dim x As Long
Dim j As Long
Dim r As Range
Dim rng As Range
Dim getMatch As Object
Dim strOut As String
Dim strIn As String

    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet    '<- change to suit
    On Error Resume Next
    Set wksOut = wkb.Sheets("Output")
    If Err.Number <> 0 Then
        Set wksOut = wkb.Worksheets.Add(after:=wkb.Worksheets(wks.Index))
        wksOut.Name = "Output"
    End If
    On Error GoTo 0
    wksOut.Cells.Clear

    Set rng = wks.Range("A1", wks.Range("A" & wks.Rows.Count).End(xlUp))
    'clean output
    wksOut.Cells.ClearContents

    wksOut.Range("A1").Value = "Output"
    For Each r In rng
        'bound the string with brackets, to start, including start/end of any line
        strIn = leftBracket & Replace(r.Value, Chr(10), rightBracket & leftBracket) & rightBracket

        'get all submatches that are bounded by the brackets
        Set getMatch = getBetweenChars(strIn, leftBracket, rightBracket)
        
        If getMatch.Count > 0 Then 'every line with data should have at least one match, based on the setup
            For j = 0 To getMatch.Count - 1
                wksOut.Range("A2").Offset(i, 0) = Replace(Replace(getMatch(j), leftBracket, vbNullString), rightBracket, vbNullString)
                i = i + 1
            Next j
        End If

    Next r
        
        wksOut.Columns("A").AutoFit
        wksOut.Rows.AutoFit
End Sub

Open in new window

and here's the getBetweenChars() function in the second module:
Option Explicit
Const MetaChars = "^$.*+?|\()[]{}<>"
Function getBetweenChars(target As String, myLeftBracket As String, myRightBracket As String) As Object
'finds and returns first match between two strings that bracket the desired outcome
Dim wkb As Workbook
Dim wks As Worksheet
Dim searchCharLeft As String
Dim searchCharRight As String
Dim regEx As Object

Dim myStr As String
Dim myMatch As Object
Dim searchChar As String
Dim firstAddress As String
Dim fRange As Range
Dim rng As Range
    
    searchCharLeft = myLeftBracket
    searchCharRight = myRightBracket
    
    If InStr(MetaChars, searchCharLeft) <> 0 Then
        searchCharLeft = "\" & searchCharLeft
    End If
    If InStr(MetaChars, searchCharRight) <> 0 Then
        searchCharRight = "\" & searchCharRight
    End If
    
    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
    Set rng = Selection
    
    Set regEx = CreateObject("VBScript.RegExp")
    
    With regEx
        .Global = True
        .MultiLine = False
        .Pattern = searchCharLeft & "(.*?)" & searchCharRight  'search for anything between < > brackets
    End With
    
    Set myMatch = regEx.Execute(target)
    Set getBetweenChars = myMatch
    
    Set regEx = Nothing
End Function

Open in new window


See attached demonstration workbook.  Download it and run the macro, check the Output tab and advise if this is satisfactory.

Enjoy!

Dave
parseAltEnterDate-r3.xlsm
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

762 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now