Solved

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

Posted on 2012-03-22
5
365 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
ID: 37755403
Did you mean to post a sample?

Dave
0
 
LVL 41

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 41

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 41

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

863 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

27 Experts available now in Live!

Get 1:1 Help Now