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

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,
ExcellearnerAsked:
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.

dlmilleCommented:
Did you mean to post a sample?

Dave
0
dlmilleCommented:
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
ExcellearnerAuthor Commented:
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
dlmilleCommented:
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
dlmilleCommented:
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

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
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.

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.