Solved

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

Posted on 2012-03-22
5
370 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
[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
  • 4
5 Comments
 
LVL 42

Expert Comment

by:dlmille
ID: 37755403
Did you mean to post a sample?

Dave
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37755902
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
ID: 37760217
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 42

Expert Comment

by:dlmille
ID: 37760227
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 42

Accepted Solution

by:
dlmille earned 500 total points
ID: 37760335
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

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!

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

728 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