Find text between delimiters in a cell and extract text between the following delimiters

[Katiedfuller]

Hi,

I've spent months trying to research a solution to my problem and after reading another post from your site that was very helpful for a different issue, I thought maybe you can help me.

In A2, there are a list of headers followed by descriptions, one-after-the-other. For example, I have the following:

House Main Color|Red Brick|House Trim Color|White|Driveway Dimensions|15 feet|Year Built|1997

In A3, I have the same, but new headers may appear and the order of the headers may shift:
House Trim Color|Green|House Main Color|White|# Front Windows|7|Year Built|1997

In B1, C1, D1, E1, and F1 I have predefined column headers:

B1 = House Main Color
C1 = House Trim Color
D1 = Driveway Dimensions
E1 = Year Built
F1 = # Front Windows

I would like for B2 to search A2 for the predefined header in B1 and return the string of text between the two | delimiters that directly follow the found B1 header in A2. If no header is found, it should return a blank. Then, C2 should search A2 for the predefined header in C1 and return the string of text between the two | delimiters that direclty follow the found C1 header in A2. If no header is found, it should return a blank. Etc., Etc., for D2, E2, and F2.

Qualifiers: The predefined headers will often appear in different places in the string of text for A2. However, the information I need returned will always appear between the two | delimiters DIRECTLY following the found predefined header in A2.

Text-to-Columns isn't helpful as the order variance causes issues.

Can you help?

Thank you!

 

[mumps]

Try:

Sub FindText()
    Application.ScreenUpdating = False
    Dim myArray As Variant
    Dim i As Long
    Dim rng As Range
    myArray = Split(Range("A2"), "|")
    For Each rng In Range("B1:F1")
        For i = LBound(myArray) To UBound(myArray)
            If rng = myArray(i) Then
                rng.Offset(1, 0) = myArray(i + 1)
            End If
        Next i
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Katiedfuller]

Try:

Sub FindText()
    Application.ScreenUpdating = False
    Dim myArray As Variant
    Dim i As Long
    Dim rng As Range
    myArray = Split(Range("A2"), "|")
    For Each rng In Range("B1:F1")
        For i = LBound(myArray) To UBound(myArray)
            If rng = myArray(i) Then
                rng.Offset(1, 0) = myArray(i + 1)
            End If
        Next i
    Next rng
    Application.ScreenUpdating = True
End Sub

Is this something I need to add into VBA? If so, how do I do that and save it in such a way that I can use it again and again?

Thanks!

 

[mumps]

Do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the menu at the top click 'Insert' and then click 'Module'. Copy and paste the macro into the empty code window that opens up. Press the F5 key to run the macro. Close the code module window to return to your sheet. There are other quicker ways to run the macro such as assigning it to a button that you would click on your sheet or assigning it to a short cut key.

 

[Rick Rothstein]

You can also do this with formulas. Put the following formula in cell B2 and copy it across to cell F2, then copy the range B2:F2 down to the bottom of your data...

=IFERROR(MID($A2,FIND("|",$A2,FIND(B$1,$A2))+1,FIND("|",$A2&"|",FIND("|",$A2,FIND(B$1,$A2))+1)-FIND("|",$A2,FIND(B$1,$A2))-1),"")

Note: I used FIND which is case sensitive, so the values in Column A must be spelled exactly the same as the headers in cells B2:F2. If that will not be the case, then change every FIND function call to SEARCH instead.

 

[Katiedfuller]

You can also do this with formulas. Put the following formula in cell B2 and copy it across to cell F2, then copy the range B2:F2 down to the bottom of your data...

=IFERROR(MID($A2,FIND("|",$A2,FIND(B$1,$A2))+1,FIND("|",$A2&"|",FIND("|",$A2,FIND(B$1,$A2))+1)-FIND("|",$A2,FIND(B$1,$A2))-1),"")

Note: I used FIND which is case sensitive, so the values in Column A must be spelled exactly the same as the headers in cells B2:F2. If that will not be the case, then change every FIND function call to SEARCH instead.

Thanks so much! This is exactly what I needed, as this allows me to add additional columns as necessary. I much appreciate your help!

 

[Rick Rothstein]

Thanks so much! This is exactly what I needed, as this allows me to add additional columns as necessary. I much appreciate your help!

You are quite welcome... glad I could help. I do note I made an error in my Note, but I don't think it bothered you any... I said "the values in Column A must be spelled exactly the same as the headers in cells B2:F2" when I should have said "cells B1:F1" where the headers are actually located.

 

[Katiedfuller]

You are quite welcome... glad I could help. I do note I made an error in my Note, but I don't think it bothered you any... I said "the values in Column A must be spelled exactly the same as the headers in cells B2:F2" when I should have said "cells B1:F1" where the headers are actually located.

Thanks for following up! I knew what you meant, and it worked beautifully. I feel like you've just giving me this week's winning lotto numbers. I wish I had found this forum month's ago... Thank you, again!

 

[Sektor]

This macros will solve your problem (here's link to Excel file with macros with example - you need to press button "Fill Values"):

Sub FillValues()


    Dim re As Object, mc As Object
    Dim r As Long, c As Long


    Set re = CreateObject("VBScript.RegExp")


    For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        For c = 2 To 5
            re.Pattern = Cells(1, c).Value & "\|(.*?)(?=\||$)"
            Set mc = re.Execute(Cells(r, 1).Value)
            If mc.Count > 0 Then
                Cells(r, c).Value = mc(0).SubMatches(0)
            End If
        Next
    Next


End Sub