Extracting a part of text in a row [SOLVED]

[luis_marques]

My data set is a row with personal data of students.


I would like to extract the name of student, but in this file the name comes together the field name like this: name: John Doe


I would like to extract all the names but removing the field name in the column A1. The rows which are blank between each student data set is variable.


Example of this file:

A1


Personal data

Name:John Doe

City: Mumbai

Cel phone: 99-99999


Personal data

Name:Dart Vader

City: Gothan City

Cel phone:999-0000


The expected result:


B1

John Doe

Dart Vader


Thanks in advance

 

[Faseeh]

Is the original data present in only one cell or in diff. rows?


Regards,

 

[luis_marques]

Faseeh, the original data is in different rows.

 

[Marc L]

Hi Luis !


Enjoy this ‼

[pre]

Sub ExtractNameFromColumnAtoB()
Application.ScreenUpdating = False

With ActiveSheet
For R& = 1 To .UsedRange.Cells(.UsedRange.Count).Row
With .Cells(R, 1)
If .Text > "" Then
AR = Split(.Text, vbLf):  N$ = ""

For Each C In AR
If LCase$(Left$(C, 5)) = "name:" Then _
N = N & IIf(N > "", vbLf, "") & Trim$(Mid$(C, 6))
Next C

If N > "" Then .Offset(, 1) = N
End If
End With
Next R
End With

Application.ScreenUpdating = True
End Sub

[/pre]

 

[luis_marques]

Thanks Marc. It worked out. But i was looking for a formula solution.

 

[Faseeh]

luis_marques,


With your data in A1:A9, try this:

=IFERROR(MID(INDEX($A$1:$A$14,SMALL(IF($A$1:$A$14=$A$1,ROW($A$1:$A$14)+1),ROW(A1))),6,999),"…")

Press Ctrl+Shift+Enter to execute and drag down.


Regards,

 

[shrivallabha]

Option A]

You can also create UDF for this. Place the following in standard module.

[pre]

Public Function ExtractNames(rng As Range)
ExtractNames = Replace(Join(Filter(Split(rng.Value, Chr(10)), "Name:", True), ", "), "Name:", "")
End Function

[/pre]
And then suppose if your data is in Cell A1 then in another cell type formula:

=ExtractNames(A1)


Option B]

This is not so elegant solution which should list down all names in separate cells. Assuming your data is consistent per your sample. In B1:

=TRIM(MID(SUBSTITUTE(MID(SUBSTITUTE($A1,"Name:","|",COLUMNS($B$1:B$1)),FIND("|",SUBSTITUTE($A1,"Name:","|",COLUMNS($B$1:B$1)),1),100),CHAR(10),REPT(" ",100)),2,99))

Copy down and across until you get error.

 

[SirJB7]

Hi, luis_marques!


After reading my colleagues solutions and considering their stature (Faseeh, Marc L, shrivallabha) I'm still wondering if I making a huge mistake and obviating a couple of elephants...


But just in case you want to give another formula try and making the same assumptions regarding your data structure about consistency (i.e., 4 rows for each student), check this:

B1: =SUSTITUIR(INDICE(A:A;(FILA()-1)*5+2);"Name:";"") -----> in english: =SUBSTITUTE(INDEX(A:A,(ROW()-1)*5+2),;"Name:","")


Normal formula, not array. Copy down as required, no error handling needed.


Regards!


EDITED


PS: Here are the elephants

"The rows which are blank between each student data set is variable."

 

[luis_marques]

What i was looking for Faseeh was precise. Thanks. Also thanks to Marc, Shrivallabha and SirJB7 (you guessed: in fact there was a herd of elephants)

 

[shrivallabha]

Sorry. I should learn reading [carefully that is] . Formula I have posted will work for cases where all data is in ONE cell.

[pre]

Public Sub ExtractArray()
Dim arr As Variant
arr = Filter(Application.Transpose(Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)), "Name:", True)
With Range("B1").Resize(UBound(arr) + 1, 1)
.Value = Application.Transpose(arr)
.Replace "Name:", vbNullString, xlPart, xlByRows, False
End With
End Sub

[/pre]

Formula based on concept that word Name will precede:

=SUBSTITUTE(INDEX($A$1:$A$9,SMALL(IF(ISNUMBER(SEARCH("Name:",$A$1:$A$9,1)),ROW($A$1:$A$9),99999),ROWS($A$1:$A1))),"Name:","")

copy down.

 

[Marc L]

Sorry but the above procedure doesn't work on my side …


In the same spirit, this is another one :

[pre]

Sub ExtractNamesA2B()
Application.ScreenUpdating = False

With ActiveSheet
For R& = 1 To .UsedRange.Cells(.UsedRange.Count).Row
With .Cells(R, 1)
N$ = Replace(Join(Filter(Split(.Text, vbLf), "Name:", , 1), vbLf), "Name:", "", , , 1)
If N > "" Then .Offset(, 1) = N
End With
Next R
End With

Application.ScreenUpdating = True
End Sub

[/pre]

 

[shrivallabha]

Marc,


The data is in "different" cells and not in "one". I have already posted UDF in the my first post which does what you have done and a formula solution.


I hope you will notice "elephant" now